Skip to content

Commit

Permalink
mpif08: add big count get_contents/get_envelope
Browse files Browse the repository at this point in the history
some cleanup for get_extent

Signed-off-by: Howard Pritchard <howardp@lanl.gov>
  • Loading branch information
hppritcha committed Sep 27, 2024
1 parent 09af8a2 commit 968fcd8
Show file tree
Hide file tree
Showing 13 changed files with 328 additions and 56 deletions.
16 changes: 14 additions & 2 deletions ompi/include/mpi.h.in
Original file line number Diff line number Diff line change
Expand Up @@ -2415,7 +2415,13 @@ OMPI_DECLSPEC int MPI_Type_get_contents(MPI_Datatype mtype, int max_integers,
int array_of_integers[],
MPI_Aint array_of_addresses[],
MPI_Datatype array_of_datatypes[]);
/* TODO: MPI_Type_get_contents_c */
OMPI_DECLSPEC int MPI_Type_get_contents_c(MPI_Datatype mtype, MPI_Count max_integers,
MPI_Count max_addresses, MPI_Count max_large_counts,
MPI_Count max_datatypes,
int array_of_integers[],
MPI_Aint array_of_addresses[],
MPI_Count array_of_large_counts[],
MPI_Datatype array_of_datatypes[]);
OMPI_DECLSPEC int MPI_Type_get_envelope(MPI_Datatype type, int *num_integers,
int *num_addresses, int *num_datatypes,
int *combiner);
Expand Down Expand Up @@ -3555,7 +3561,13 @@ OMPI_DECLSPEC int PMPI_Type_get_contents(MPI_Datatype mtype, int max_integers,
int array_of_integers[],
MPI_Aint array_of_addresses[],
MPI_Datatype array_of_datatypes[]);
/* TODO: MPI_Type_get_contents_c */
OMPI_DECLSPEC int PMPI_Type_get_contents_c(MPI_Datatype mtype, MPI_Count max_integers,
MPI_Count max_addresses, MPI_Count max_large_counts,
MPI_Count max_datatypes,
int array_of_integers[],
MPI_Aint array_of_addresses[],
MPI_Count array_of_large_counts[],
MPI_Datatype array_of_datatypes[]);
OMPI_DECLSPEC int PMPI_Type_get_envelope(MPI_Datatype type, int *num_integers,
int *num_addresses, int *num_datatypes,
int *combiner);
Expand Down
97 changes: 97 additions & 0 deletions ompi/mpi/fortran/mpif-h/type_get_contents_f.c
Original file line number Diff line number Diff line change
Expand Up @@ -129,3 +129,100 @@ void ompi_type_get_contents_f(MPI_Fint *mtype, MPI_Fint *max_integers,
free(c_datatype_array);
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_integers);
}

/*
* big count entry point, only needed by F08 bindings.
*/

void ompi_type_get_contents_f_c(MPI_Fint *mtype, MPI_Count *max_integers,
MPI_Count *max_addresses, MPI_Count *max_large_counts,
MPI_Count *max_datatypes,
MPI_Fint *array_of_integers,
MPI_Aint *array_of_addresses,
MPI_Count *array_of_large_counts,
MPI_Fint *array_of_datatypes, MPI_Fint *ierr);
void ompi_type_get_contents_f_c(MPI_Fint *mtype, MPI_Count *max_integers,
MPI_Count *max_addresses, MPI_Count *max_large_counts,
MPI_Count *max_datatypes,
MPI_Fint *array_of_integers,
MPI_Aint *array_of_addresses,
MPI_Count *array_of_large_counts,
MPI_Fint *array_of_datatypes, MPI_Fint *ierr)
{
MPI_Aint *c_address_array = NULL;
MPI_Count *c_large_counts_array = NULL;
MPI_Datatype *c_datatype_array = NULL;
MPI_Datatype c_mtype = PMPI_Type_f2c(*mtype);
int i, c_ierr;
OMPI_ARRAY_NAME_DECL(array_of_integers);

if (*max_datatypes) {
c_datatype_array = (MPI_Datatype *) malloc(*max_datatypes * sizeof(MPI_Datatype));
if (NULL == c_datatype_array) {
c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM,
FUNC_NAME);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
return;
}
}

if (*max_addresses) {
c_address_array = (MPI_Aint *) malloc(*max_addresses * sizeof(MPI_Aint));
if (NULL == c_address_array) {
if (NULL != c_datatype_array) {
free(c_datatype_array);
}

c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM,
FUNC_NAME);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
return;
}
}

if (*max_large_counts) {
c_large_counts_array = (MPI_Count *) malloc(*max_large_counts * sizeof(MPI_Count));
if (NULL == c_large_counts_array) {
if (NULL != c_datatype_array) {
free(c_datatype_array);
}
if (NULL != c_address_array) {
free(c_address_array);
}

c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM,
FUNC_NAME);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
return;
}
}

OMPI_ARRAY_FINT_2_INT(array_of_integers, *max_integers);

c_ierr = PMPI_Type_get_contents_c(c_mtype,
OMPI_FINT_2_INT(*max_integers),
OMPI_FINT_2_INT(*max_addresses),
OMPI_FINT_2_INT(*max_datatypes),
OMPI_FINT_2_INT(*max_large_counts),
OMPI_ARRAY_NAME_CONVERT(array_of_integers),
c_address_array, c_large_counts_array,
c_datatype_array);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);

if (MPI_SUCCESS == c_ierr) {
for (i = 0; i < *max_addresses; i++) {
array_of_addresses[i] = c_address_array[i];
}
for (i = 0; i < *max_large_counts; i++) {
array_of_large_counts[i] = c_large_counts_array[i];
}
for (i = 0; i < *max_datatypes; i++) {
array_of_datatypes[i] = PMPI_Type_c2f(c_datatype_array[i]);
}
}
free(c_address_array);
free(c_datatype_array);
free(c_large_counts_array);
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_integers);
}

39 changes: 39 additions & 0 deletions ompi/mpi/fortran/mpif-h/type_get_envelope_f.c
Original file line number Diff line number Diff line change
Expand Up @@ -92,3 +92,42 @@ void ompi_type_get_envelope_f(MPI_Fint *type, MPI_Fint *num_integers,
OMPI_SINGLE_INT_2_FINT(combiner);
}
}


/*
* big count entry point, only needed by F08 bindings.
*/

void ompi_type_get_envelope_f_c(MPI_Fint *type, MPI_Count *num_integers,
MPI_Count *num_addresses,
MPI_Count *num_large_counts,
MPI_Count *num_datatypes, MPI_Fint *combiner,
MPI_Fint *ierr);
void ompi_type_get_envelope_f_c(MPI_Fint *type, MPI_Count *num_integers,
MPI_Count *num_addresses,
MPI_Count *num_large_counts,
MPI_Count *num_datatypes, MPI_Fint *combiner,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_type = PMPI_Type_f2c(*type);
OMPI_SINGLE_NAME_DECL(num_integers);
OMPI_SINGLE_NAME_DECL(num_addresses);
OMPI_SINGLE_NAME_DECL(num_datatypes);
OMPI_SINGLE_NAME_DECL(combiner);

c_ierr = PMPI_Type_get_envelope_c(c_type,
OMPI_SINGLE_NAME_CONVERT(num_integers),
OMPI_SINGLE_NAME_CONVERT(num_addresses),
OMPI_SINGLE_NAME_CONVERT(num_large_counts),
OMPI_SINGLE_NAME_CONVERT(num_datatypes),
OMPI_SINGLE_NAME_CONVERT(combiner));
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);

if (MPI_SUCCESS == c_ierr) {
OMPI_SINGLE_INT_2_FINT(num_integers);
OMPI_SINGLE_INT_2_FINT(num_addresses);
OMPI_SINGLE_INT_2_FINT(num_datatypes);
OMPI_SINGLE_INT_2_FINT(combiner);
}
}
53 changes: 53 additions & 0 deletions ompi/mpi/fortran/mpif-h/type_get_envelope_f_c.c
Original file line number Diff line number Diff line change
@@ -0,0 +1,53 @@
/*
* Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
* University Research and Technology
* Corporation. All rights reserved.
* Copyright (c) 2004-2005 The University of Tennessee and The University
* of Tennessee Research Foundation. All rights
* reserved.
* Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
* University of Stuttgart. All rights reserved.
* Copyright (c) 2004-2005 The Regents of the University of California.
* All rights reserved.
* Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved.
* Copyright (c) 2015 Research Organization for Information Science
* and Technology (RIST). All rights reserved.
* $COPYRIGHT$
*
* Additional copyrights may follow
*
* $HEADER$
*/

#include "ompi_config.h"

#include "ompi/mpi/fortran/mpif-h/bindings.h"

void ompi_type_get_envelope_f_c(MPI_Fint *type, MPI_Count *num_integers,
MPI_Count *num_addresses,
MPI_Count *num_large_counts,
MPI_Count *num_datatypes, MPI_Fint *combiner,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_type = PMPI_Type_f2c(*type);
OMPI_SINGLE_NAME_DECL(num_integers);
OMPI_SINGLE_NAME_DECL(num_addresses);
OMPI_SINGLE_NAME_DECL(num_datatypes);
OMPI_SINGLE_NAME_DECL(combiner);

c_ierr = PMPI_Type_get_envelope_c(c_type,
OMPI_SINGLE_NAME_CONVERT(num_integers),
OMPI_SINGLE_NAME_CONVERT(num_addresses),
OMPI_SINGLE_NAME_CONVERT(num_large_counts),
OMPI_SINGLE_NAME_CONVERT(num_datatypes),
OMPI_SINGLE_NAME_CONVERT(combiner));
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);

if (MPI_SUCCESS == c_ierr) {
OMPI_SINGLE_INT_2_FINT(num_integers);
OMPI_SINGLE_INT_2_FINT(num_addresses);
OMPI_SINGLE_INT_2_FINT(num_datatypes);
OMPI_SINGLE_INT_2_FINT(combiner);
}
}
16 changes: 16 additions & 0 deletions ompi/mpi/fortran/mpif-h/type_get_extent_f.c
Original file line number Diff line number Diff line change
Expand Up @@ -75,3 +75,19 @@ void ompi_type_get_extent_f(MPI_Fint *type, MPI_Aint *lb,
c_ierr = PMPI_Type_get_extent(c_type, lb, extent);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}


/*
* big count entry point, only needed by F08 bindings.
*/
void ompi_type_get_extent_f_c(MPI_Fint *type, MPI_Count *lb,
MPI_Count *extent, MPI_Fint *ierr);
void ompi_type_get_extent_f_c(MPI_Fint *type, MPI_Count *lb,
MPI_Count *extent, MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_type = PMPI_Type_f2c(*type);

c_ierr = PMPI_Type_get_extent_c(c_type, lb, extent);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
3 changes: 3 additions & 0 deletions ompi/mpi/fortran/use-mpi-f08/Makefile.am
Original file line number Diff line number Diff line change
Expand Up @@ -343,10 +343,13 @@ mpi_api_files = \
type_free_keyval_f08.F90 \
type_get_attr_f08.F90 \
type_get_contents_f08.F90 \
type_get_contents_f08_c.F90 \
type_get_extent_f08.F90 \
type_get_extent_x_f08.F90 \
type_get_name_f08.F90 \
type_get_true_extent_x_f08.F90 \
type_get_envelope_f08.F90 \
type_get_envelope_f08_c.F90 \
type_match_size_f08.F90 \
type_set_attr_f08.F90 \
type_set_name_f08.F90 \
Expand Down
26 changes: 26 additions & 0 deletions ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h
Original file line number Diff line number Diff line change
Expand Up @@ -771,6 +771,21 @@ subroutine ompi_type_get_contents_f(datatype,max_integers,max_addresses, &
INTEGER, INTENT(OUT) :: ierror
end subroutine ompi_type_get_contents_f

subroutine ompi_type_get_contents_f_c(datatype,max_integers,max_addresses, &
max_large_counts, max_datatypes,array_of_integers,array_of_addresses, &
array_of_large_counts, array_of_datatypes,ierror) &
BIND(C, name="ompi_type_get_contents_f_c")
use :: mpi_f08_types, only : MPI_ADDRESS_KIND, MPI_COUNT_KIND
implicit none
INTEGER, INTENT(IN) :: datatype
INTEGER(KIND=MPI_COUNT_KIND), INTENT(IN) :: max_integers, max_addresses, max_large_counts, max_datatypes
INTEGER, INTENT(OUT) :: array_of_integers(max_integers)
INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: array_of_addresses(max_addresses)
INTEGER(KIND=MPI_COUNT_KIND), INTENT(OUT) :: array_of_large_counts(max_large_counts)
INTEGER, INTENT(OUT) :: array_of_datatypes(max_datatypes)
INTEGER, INTENT(OUT) :: ierror
end subroutine ompi_type_get_contents_f_c

subroutine ompi_type_get_envelope_f(datatype,num_integers, &
num_addresses,num_datatypes,combiner,ierror) &
BIND(C, name="ompi_type_get_envelope_f")
Expand All @@ -780,6 +795,17 @@ subroutine ompi_type_get_envelope_f(datatype,num_integers, &
INTEGER, INTENT(OUT) :: ierror
end subroutine ompi_type_get_envelope_f

subroutine ompi_type_get_envelope_f_c(datatype,num_integers, num_addresses, &
num_large_counts, num_datatypes,combiner,ierror) &
BIND(C, name="ompi_type_get_envelope_f_c")
use :: mpi_f08_types, only : MPI_COUNT_KIND
implicit none
INTEGER, INTENT(IN) :: datatype
INTEGER(KIND=MPI_COUNT_KIND), INTENT(OUT) :: num_integers, num_large_counts, num_addresses, &
num_datatypes, combiner
INTEGER, INTENT(OUT) :: ierror
end subroutine ompi_type_get_envelope_f_c

subroutine ompi_type_get_extent_f(datatype,lb,extent,ierror) &
BIND(C, name="ompi_type_get_extent_f")
use :: mpi_f08_types, only : MPI_ADDRESS_KIND
Expand Down
19 changes: 17 additions & 2 deletions ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in
Original file line number Diff line number Diff line change
Expand Up @@ -595,6 +595,20 @@ subroutine MPI_Type_get_contents_f08(datatype,max_integers,max_addresses,max_dat
TYPE(MPI_Datatype), INTENT(OUT) :: array_of_datatypes(max_datatypes)
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
end subroutine MPI_Type_get_contents_f08
subroutine MPI_Type_get_contents_f08_c(datatype, max_integers, max_addresses, max_large_counts, &
max_datatypes, array_of_integers, array_of_addresses, &
array_of_large_counts, array_of_datatypes, ierror)
use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND, MPI_COUNT_KIND
implicit none
TYPE(MPI_Datatype), INTENT(IN) :: datatype
INTEGER(KIND=MPI_COUNT_KIND), INTENT(IN) :: max_integers, max_addresses, &
max_large_counts, max_datatypes
INTEGER, INTENT(OUT) :: array_of_integers(max_integers)
INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: array_of_addresses(max_addresses)
INTEGER(KIND=MPI_COUNT_KIND), INTENT(OUT) :: array_of_large_counts(max_large_counts)
TYPE(MPI_Datatype), INTENT(OUT) :: array_of_datatypes(max_datatypes)
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
end subroutine MPI_Type_get_contents_f08_c
end interface MPI_Type_get_contents

interface MPI_Type_get_envelope
Expand All @@ -606,12 +620,13 @@ subroutine MPI_Type_get_envelope_f08(datatype,num_integers,num_addresses,num_dat
INTEGER, INTENT(OUT) :: num_integers, num_addresses, num_datatypes, combiner
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
end subroutine MPI_Type_get_envelope_f08
subroutine MPI_Type_get_envelope_f08_c(datatype,num_integers,num_addresses,num_datatypes, &
subroutine MPI_Type_get_envelope_f08_c(datatype,num_integers,num_addresses,num_large_counts,num_datatypes, &
combiner,ierror)
use :: mpi_f08_types, only : MPI_Datatype, MPI_COUNT_KIND
implicit none
TYPE(MPI_Datatype), INTENT(IN) :: datatype
INTEGER(MPI_COUNT_KIND), INTENT(OUT) :: num_integers, num_addresses, num_datatypes, combiner
INTEGER(MPI_COUNT_KIND), INTENT(OUT) :: num_integers, num_addresses, num_large_counts, num_datatypes
INTEGER, INTENT(OUT) :: combiner
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
end subroutine MPI_Type_get_envelope_f08_c
end interface MPI_Type_get_envelope
Expand Down
2 changes: 2 additions & 0 deletions ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h
Original file line number Diff line number Diff line change
Expand Up @@ -158,8 +158,10 @@
#define MPI_Type_free_f08 PMPI_Type_free_f08
#define MPI_Type_get_contents PMPI_Type_get_contents
#define MPI_Type_get_contents_f08 PMPI_Type_get_contents_f08
#define MPI_Type_get_contents_f08_c PMPI_Type_get_contents_f08_c
#define MPI_Type_get_envelope PMPI_Type_get_envelope
#define MPI_Type_get_envelope_f08 PMPI_Type_get_envelope_f08
#define MPI_Type_get_envelope_f08_c PMPI_Type_get_envelope_f08_c
#define MPI_Type_get_extent PMPI_Type_get_extent
#define MPI_Type_get_extent_f08 PMPI_Type_get_extent_f08
#define MPI_Type_get_extent_x PMPI_Type_get_extent_x
Expand Down
33 changes: 33 additions & 0 deletions ompi/mpi/fortran/use-mpi-f08/type_get_contents_f08_c.F90
Original file line number Diff line number Diff line change
@@ -0,0 +1,33 @@
! -*- f90 -*-
!
! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved.
! Copyright (c) 2009-2012 Los Alamos National Security, LLC.
! All rights reserved.
! Copyright (c) 2018-2020 Research Organization for Information Science
! and Technology (RIST). All rights reserved.
! $COPYRIGHT$

#include "mpi-f08-rename.h"

subroutine MPI_Type_get_contents_f08_c(datatype, max_integers, max_addresses, max_large_counts, &
max_datatypes, array_of_integers, array_of_addresses, &
array_of_large_counts, array_of_datatypes, ierror)
use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND, MPI_COUNT_KIND
use :: ompi_mpifh_bindings, only : ompi_type_get_contents_f_c
implicit none
TYPE(MPI_Datatype), INTENT(IN) :: datatype
INTEGER(KIND=MPI_COUNT_KIND), INTENT(IN) :: max_integers, max_addresses, &
max_large_counts, max_datatypes
INTEGER, INTENT(OUT) :: array_of_integers(max_integers)
INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: array_of_addresses(max_addresses)
INTEGER(KIND=MPI_COUNT_KIND), INTENT(OUT) :: array_of_large_counts(max_large_counts)
TYPE(MPI_Datatype), INTENT(OUT) :: array_of_datatypes(max_datatypes)
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
integer :: c_ierror

call ompi_type_get_contents_f_c(datatype%MPI_VAL,max_integers,max_addresses, &
max_large_counts, max_datatypes,array_of_integers,array_of_addresses, &
array_of_large_counts, array_of_datatypes(:)%MPI_VAL,c_ierror)
if (present(ierror)) ierror = c_ierror

end subroutine MPI_Type_get_contents_f08_c
Loading

0 comments on commit 968fcd8

Please sign in to comment.