-
Notifications
You must be signed in to change notification settings - Fork 868
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
fortran/use-mpi-f08: add support for Fortran 2018 ISO_Fortran_binding.h
Signed-off-by: Gilles Gouaillardet <[email protected]>
- Loading branch information
1 parent
2935f92
commit 79c6e22
Showing
8 changed files
with
176 additions
and
18 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,94 @@ | ||
| /* -*- Mode: C; c-basic-offset:4 ; -*- */ | ||
| /* | ||
| * Copyright (c) 2014 Argonne National Laboratory. | ||
| * Copyright (c) 2019 Research Organization for Information Science | ||
| * and Technology (RIST). All rights reserved. | ||
| * $COPYRIGHT$ | ||
| * | ||
| * Additional copyrights may follow | ||
| * | ||
| * $HEADER$ | ||
| */ | ||
|
|
||
| #include "ts.h" | ||
|
|
||
| #include <assert.h> | ||
|
|
||
| int ompi_ts_create_datatype(CFI_cdesc_t *cdesc, int oldcount, MPI_Datatype oldtype, MPI_Datatype *newtype) | ||
| { | ||
| const int MAX_RANK = 15; /* Fortran 2008 specifies a maximum rank of 15 */ | ||
| MPI_Datatype types[MAX_RANK + 1]; /* Use a fixed size array to avoid malloc. + 1 for oldtype */ | ||
| int mpi_errno = MPI_SUCCESS; | ||
| int accum_elems = 1; | ||
| int accum_sm = cdesc->elem_len; | ||
| int done = 0; /* Have we created a datatype for oldcount of oldtype? */ | ||
| int last; /* Index of the last successfully created datatype in types[] */ | ||
| int extent; | ||
| int i, j; | ||
|
|
||
| #ifdef OPAL_ENABLE_DEBUG | ||
| { | ||
| size_t size; | ||
| assert(cdesc->rank <= MAX_RANK); | ||
| ompi_datatype_type_size(oldtype, &size); | ||
| /* When cdesc->elem_len != size, things suddenly become complicated. Generally, it is hard to create | ||
| * a composite datatype based on two datatypes. Currently we don't support it and doubt it is usefull. | ||
| */ | ||
| assert(cdesc->elem_len == size); | ||
| } | ||
| #endif | ||
|
|
||
| types[0] = oldtype; | ||
| i = 0; | ||
| done = 0; | ||
| while (i < cdesc->rank && !done) { | ||
| if (oldcount % accum_elems) { | ||
| /* oldcount should be a multiple of accum_elems, otherwise we might need an | ||
| * MPI indexed datatype to describle the irregular region, which is not supported yet. | ||
| */ | ||
| mpi_errno = MPI_ERR_INTERN; | ||
| last = i; | ||
| goto fn_exit; | ||
| } | ||
|
|
||
| extent = oldcount / accum_elems; | ||
| if (extent > cdesc->dim[i].extent) { | ||
| extent = cdesc->dim[i].extent; | ||
| } else { | ||
| /* Up to now, we have accumlated enough elements */ | ||
| done = 1; | ||
| } | ||
|
|
||
| if (cdesc->dim[i].sm == accum_sm) { | ||
| mpi_errno = PMPI_Type_contiguous(extent, types[i], &types[i+1]); | ||
| } else { | ||
| mpi_errno = PMPI_Type_create_hvector(extent, 1, cdesc->dim[i].sm, types[i], &types[i+1]); | ||
| } | ||
| if (mpi_errno != MPI_SUCCESS) { | ||
| last = i; | ||
| goto fn_exit; | ||
| } | ||
|
|
||
| accum_sm = cdesc->dim[i].sm * cdesc->dim[i].extent; | ||
| accum_elems *= cdesc->dim[i].extent; | ||
| i++; | ||
| } | ||
|
|
||
| if (done) { | ||
| *newtype = types[i]; | ||
| MPI_Type_commit(newtype); | ||
| last = i - 1; /* To avoid freeing newtype */ | ||
| } else { | ||
| /* If # of elements given by "oldcount oldtype" is bigger than | ||
| * what cdesc describles, then we will reach here. | ||
| */ | ||
| last = i; | ||
| mpi_errno = MPI_ERR_ARG; | ||
| goto fn_exit; | ||
| } | ||
|
|
||
| fn_exit: | ||
| for (j = 1; j <= last; j++) | ||
| PMPI_Type_free(&types[j]); | ||
| return mpi_errno; | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,48 @@ | ||
| /* -*- Mode: C; c-basic-offset:4 ; -*- */ | ||
| /* | ||
| * Copyright (c) 2014 Argonne National Laboratory. | ||
| * Copyright (c) 2019 Research Organization for Information Science | ||
| * and Technology (RIST). All rights reserved. | ||
| * $COPYRIGHT$ | ||
| * | ||
| * Additional copyrights may follow | ||
| * | ||
| * $HEADER$ | ||
| */ | ||
|
|
||
| #include "ompi_config.h" | ||
|
|
||
| #include <ISO_Fortran_binding.h> | ||
|
|
||
| #include "ompi/datatype/ompi_datatype.h" | ||
| #include "ompi/mpi/fortran/base/fint_2_int.h" | ||
|
|
||
| extern int ompi_ts_create_datatype(CFI_cdesc_t *cdesc, int oldcount, MPI_Datatype oldtype, MPI_Datatype *newtype); | ||
|
|
||
| #define OMPI_CFI_2_C(x, count, type, datatype, rc) \ | ||
| do { \ | ||
| datatype = type; \ | ||
| if (x->rank != 0 && !CFI_is_contiguous(x)) { \ | ||
| rc = ompi_ts_create_datatype(x, count, type, &datatype); \ | ||
| if (MPI_SUCCESS != rc) { \ | ||
| return; \ | ||
| } else { \ | ||
| count = 1; \ | ||
| } \ | ||
| } else { \ | ||
| rc = MPI_SUCCESS; \ | ||
| } \ | ||
| } while (0) | ||
|
|
||
| #define OMPI_CFI_IS_CONTIGUOUS(x) \ | ||
| (0 == x->rank || CFI_is_contiguous(x)) | ||
|
|
||
| #define OMPI_CFI_CHECK_CONTIGUOUS(x, rc) \ | ||
| do { \ | ||
| if (OMPI_CFI_IS_CONTIGUOUS(x)) { \ | ||
| rc = MPI_SUCCESS; \ | ||
| } else { \ | ||
| rc = MPI_ERR_INTERN; \ | ||
| } \ | ||
| } while (0) | ||
|
|