|
| 1 | +/* -*- Mode: C; c-basic-offset:4 ; -*- */ |
| 2 | +/* |
| 3 | + * Copyright (c) 2014 Argonne National Laboratory. |
| 4 | + * Copyright (c) 2019 Research Organization for Information Science |
| 5 | + * and Technology (RIST). All rights reserved. |
| 6 | + * $COPYRIGHT$ |
| 7 | + * |
| 8 | + * Additional copyrights may follow |
| 9 | + * |
| 10 | + * $HEADER$ |
| 11 | + */ |
| 12 | + |
| 13 | +#include "cdesc.h" |
| 14 | + |
| 15 | +int cdesc_create_datatype(CFI_cdesc_t *cdesc, int oldcount, MPI_Datatype oldtype, MPI_Datatype *newtype) |
| 16 | +{ |
| 17 | + const int MAX_RANK = 15; /* Fortran 2008 specifies a maximum rank of 15 */ |
| 18 | + MPI_Datatype types[MAX_RANK + 1]; /* Use a fixed size array to avoid malloc. + 1 for oldtype */ |
| 19 | + int mpi_errno = MPI_SUCCESS; |
| 20 | + int accum_elems = 1; |
| 21 | + int accum_sm = cdesc->elem_len; |
| 22 | + int done = 0; /* Have we created a datatype for oldcount of oldtype? */ |
| 23 | + int last; /* Index of the last successfully created datatype in types[] */ |
| 24 | + int extent; |
| 25 | + int i, j; |
| 26 | + |
| 27 | +#ifdef OPAL_ENABLE_DEBUG |
| 28 | + { |
| 29 | + int size; |
| 30 | + assert(cdesc->rank <= MAX_RANK); |
| 31 | + ompi_datatype_size(oldtype, &size); |
| 32 | + /* When cdesc->elem_len != size, things suddenly become complicated. Generally, it is hard to create |
| 33 | + * a composite datatype based on two datatypes. Currently we don't support it and doubt it is usefull. |
| 34 | + */ |
| 35 | + assert(cdesc->elem_len == size); |
| 36 | + } |
| 37 | +#endif |
| 38 | + |
| 39 | + types[0] = oldtype; |
| 40 | + i = 0; |
| 41 | + done = 0; |
| 42 | + while (i < cdesc->rank && !done) { |
| 43 | + if (oldcount % accum_elems) { |
| 44 | + /* oldcount should be a multiple of accum_elems, otherwise we might need an |
| 45 | + * MPI indexed datatype to describle the irregular region, which is not supported yet. |
| 46 | + */ |
| 47 | + mpi_errno = MPI_ERR_INTERN; |
| 48 | + last = i; goto fn_exit; |
| 49 | + } |
| 50 | + |
| 51 | + extent = oldcount / accum_elems; |
| 52 | + if (extent > cdesc->dim[i].extent) { |
| 53 | + extent = cdesc->dim[i].extent; |
| 54 | + } else { |
| 55 | + /* Up to now, we have accumlated enough elements */ |
| 56 | + done = 1; |
| 57 | + } |
| 58 | + |
| 59 | + if (cdesc->dim[i].sm == accum_sm) { |
| 60 | + mpi_errno = PMPI_Type_contiguous(extent, types[i], &types[i+1]); |
| 61 | + } else { |
| 62 | + mpi_errno = PMPI_Type_create_hvector(extent, 1, cdesc->dim[i].sm, types[i], &types[i+1]); |
| 63 | + } |
| 64 | + if (mpi_errno != MPI_SUCCESS) { |
| 65 | + last = i; goto fn_exit; |
| 66 | + } |
| 67 | + |
| 68 | + mpi_errno = PMPI_Type_commit(&types[i+1]); |
| 69 | + if (mpi_errno != MPI_SUCCESS) { |
| 70 | + last = i + 1; goto fn_exit; |
| 71 | + } |
| 72 | + |
| 73 | + accum_sm = cdesc->dim[i].sm * cdesc->dim[i].extent; |
| 74 | + accum_elems *= cdesc->dim[i].extent; |
| 75 | + i++; |
| 76 | + } |
| 77 | + |
| 78 | + if (done) { |
| 79 | + *newtype = types[i]; |
| 80 | + last = i - 1; /* To avoid freeing newtype */ |
| 81 | + } else { |
| 82 | + /* If # of elements given by "oldcount oldtype" is bigger than |
| 83 | + * what cdesc describles, then we will reach here. |
| 84 | + */ |
| 85 | + last = i; |
| 86 | + mpi_errno = MPI_ERR_ARG; |
| 87 | + goto fn_exit; |
| 88 | + } |
| 89 | + |
| 90 | +fn_exit: |
| 91 | + for (j = 1; j <= last; j++) |
| 92 | + PMPI_Type_free(&types[j]); |
| 93 | + return mpi_errno; |
| 94 | +} |
0 commit comments