diff --git a/.gitignore b/.gitignore index 694d6325d53..4a1baada79d 100644 --- a/.gitignore +++ b/.gitignore @@ -219,6 +219,7 @@ ompi/mpi/fortran/mpiext/mpi-ext-module.F90 ompi/mpi/fortran/mpiext/mpi-f08-ext-module.F90 ompi/mpi/fortran/mpiext-use-mpi/mpi-ext-module.F90 ompi/mpi/fortran/mpiext-use-mpi-f08/mpi-f08-ext-module.F90 +ompi/mpi/fortran/use-mpi-f08/psizeof_f08.f90 ompi/mpi/fortran/mpif-h/sizeof_f.f90 ompi/mpi/fortran/mpif-h/profile/p*.c diff --git a/config/ompi_config_files.m4 b/config/ompi_config_files.m4 index dde7f9cd1aa..69b12fa6b82 100644 --- a/config/ompi_config_files.m4 +++ b/config/ompi_config_files.m4 @@ -40,7 +40,6 @@ AC_DEFUN([OMPI_CONFIG_FILES],[ ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-file-interfaces.h ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-removed-interfaces.h ompi/mpi/fortran/use-mpi-f08/Makefile - ompi/mpi/fortran/use-mpi-f08/profile/Makefile ompi/mpi/fortran/use-mpi-f08/base/Makefile ompi/mpi/fortran/use-mpi-f08/bindings/Makefile ompi/mpi/fortran/use-mpi-f08/mod/Makefile diff --git a/ompi/mpi/bindings/ompi_bindings/fortran.py b/ompi/mpi/bindings/ompi_bindings/fortran.py index b4a72a9e945..df51b54c56a 100644 --- a/ompi/mpi/bindings/ompi_bindings/fortran.py +++ b/ompi/mpi/bindings/ompi_bindings/fortran.py @@ -229,7 +229,7 @@ def print_c_source_header(out): out.dump('#include "ompi/errhandler/errhandler.h"') out.dump('#include "ompi/datatype/ompi_datatype.h"') out.dump('#include "ts.h"') - out.dump('#include "array.h"') + out.dump('#include "bigcount.h"') def print_binding(prototype, lang, out, bigcount=False, template=None): diff --git a/ompi/mpi/fortran/base/fint_2_int.h b/ompi/mpi/fortran/base/fint_2_int.h index 3cffe37a719..15b55eaa867 100644 --- a/ompi/mpi/fortran/base/fint_2_int.h +++ b/ompi/mpi/fortran/base/fint_2_int.h @@ -33,21 +33,22 @@ */ #if OMPI_SIZEOF_FORTRAN_INTEGER == SIZEOF_INT - #define OMPI_ARRAY_NAME_DECL(a) int *c_##a = NULL - #define OMPI_2_DIM_ARRAY_NAME_DECL(a, dim2) int (*c_##a)[dim2] + #define OMPI_ARRAY_NAME_DECL(a) + #define OMPI_2_DIM_ARRAY_NAME_DECL(a, dim2) #define OMPI_SINGLE_NAME_DECL(a) - #define OMPI_ARRAY_NAME_CONVERT(a) c_##a + #define OMPI_ARRAY_NAME_CONVERT(a) a #define OMPI_SINGLE_NAME_CONVERT(a) a #define OMPI_INT_2_FINT(a) a #define OMPI_FINT_2_INT(a) a #define OMPI_PFINT_2_PINT(a) a - #define OMPI_ARRAY_FINT_2_INT_ALLOC(in, n) { OMPI_ARRAY_NAME_CONVERT(in) = in; } - #define OMPI_ARRAY_FINT_2_INT(in, n) { OMPI_ARRAY_NAME_CONVERT(in) = in; } - #define OMPI_2_DIM_ARRAY_FINT_2_INT(in, n, dim2) { OMPI_ARRAY_NAME_CONVERT(in) = in; } + #define OMPI_ARRAY_FINT_2_INT_ALLOC(in, n) + #define OMPI_ARRAY_FINT_2_INT(in, n) + #define OMPI_2_DIM_ARRAY_FINT_2_INT(in, n, dim2) #define OMPI_ARRAY_FINT_2_INT_CLEANUP(in) #define OMPI_SINGLE_FINT_2_INT(in) #define OMPI_SINGLE_INT_2_FINT(in) #define OMPI_ARRAY_INT_2_FINT(in, n) + #define OMPI_COND_STATEMENT(a) #elif OMPI_SIZEOF_FORTRAN_INTEGER > SIZEOF_INT #define OMPI_ARRAY_NAME_DECL(a) int *c_##a = NULL @@ -87,7 +88,8 @@ /* This is for IN parameters. Does only free */ #define OMPI_ARRAY_FINT_2_INT_CLEANUP(in) \ - free(OMPI_ARRAY_NAME_CONVERT(in)) + if (NULL != OMPI_ARRAY_NAME_CONVERT(in)) \ + free(OMPI_ARRAY_NAME_CONVERT(in)) /* This is for single IN parameter */ #define OMPI_SINGLE_FINT_2_INT(in) \ @@ -106,6 +108,8 @@ } \ free(OMPI_ARRAY_NAME_CONVERT(in)); \ } while (0) + + #define OMPI_COND_STATEMENT(a) a #else /* int > MPI_Fint */ #define OMPI_ARRAY_NAME_DECL(a) int *c_##a = NULL #define OMPI_2_DIM_ARRAY_NAME_DECL(a, dim2) int (*c_##a)[dim2], dim2_index @@ -141,7 +145,8 @@ } while (0) #define OMPI_ARRAY_FINT_2_INT_CLEANUP(in) \ - free(OMPI_ARRAY_NAME_CONVERT(in)) + if (NULL != OMPI_ARRAY_NAME_CONVERT(in)) \ + free(OMPI_ARRAY_NAME_CONVERT(in)) #define OMPI_SINGLE_FINT_2_INT(in) \ OMPI_ARRAY_NAME_CONVERT(in) = *(in) @@ -158,6 +163,7 @@ free(OMPI_ARRAY_NAME_CONVERT(in)); \ } while (0) + #define OMPI_COND_STATEMENT(a) a #endif /* diff --git a/ompi/mpi/fortran/configure-fortran-output.h.in b/ompi/mpi/fortran/configure-fortran-output.h.in index 2c96d83a2b6..ed239693b15 100644 --- a/ompi/mpi/fortran/configure-fortran-output.h.in +++ b/ompi/mpi/fortran/configure-fortran-output.h.in @@ -43,6 +43,9 @@ ! Line 2 of the ignore TKR syntax #define OMPI_FORTRAN_IGNORE_TKR_TYPE @OMPI_FORTRAN_IGNORE_TKR_TYPE@ +! f08 TKR syntax (w/o TS 29113) +#define OMPI_F08_IGNORE_TKR_PREDECL @OMPI_F08_IGNORE_TKR_PREDECL@ +#define OMPI_F08_IGNORE_TKR_TYPE @OMPI_F08_IGNORE_TKR_TYPE@ #define OMPI_FORTRAN_BUILD_SIZEOF @OMPI_FORTRAN_BUILD_SIZEOF@ ! Integers diff --git a/ompi/mpi/fortran/use-mpi-f08/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/Makefile.am index 9440b7a9c23..2b41b5c8796 100644 --- a/ompi/mpi/fortran/use-mpi-f08/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-f08/Makefile.am @@ -23,8 +23,6 @@ # $HEADER$ # -SUBDIRS = profile - include $(top_srcdir)/Makefile.ompi-rules # Note that Automake's Fortran-buidling rules uses CPPFLAGS and @@ -45,14 +43,14 @@ AM_FCFLAGS = -I$(top_srcdir)/ompi/mpi/fortran/use-mpi-f08/mod \ $(OMPI_FC_MODULE_FLAG)$(top_builddir)/ompi/$(OMPI_FORTRAN_USEMPI_DIR) \ $(OMPI_FC_MODULE_FLAG)mod \ $(OMPI_FC_MODULE_FLAG)bindings \ - -I$(top_srcdir) -I$(top_builddir) $(FCFLAGS_f90) \ - -DOMPI_BUILD_MPI_PROFILING=0 + -I$(top_srcdir) -I$(top_builddir) $(FCFLAGS_f90) MOSTLYCLEANFILES = *.mod CLEANFILES += *.i90 lib_LTLIBRARIES = lib@OMPI_LIBMPI_NAME@_usempif08.la +noinst_LTLIBRARIES = lib@OMPI_LIBMPI_NAME@_usempif08_profile.la module_sentinel_files = \ mod/libforce_usempif08_internal_modules_to_be_built.la \ @@ -97,9 +95,9 @@ sizeof_f08.f90: --complex4=$(OMPI_HAVE_FORTRAN_COMPLEX4) \ --complex32=$(OMPI_HAVE_FORTRAN_COMPLEX32) -profile/psizeof_f08.f90: $(top_builddir)/config.status -profile/psizeof_f08.f90: $(sizeof_pl) -profile/psizeof_f08.f90: +psizeof_f08.f90: $(top_builddir)/config.status +psizeof_f08.f90: $(sizeof_pl) +psizeof_f08.f90: $(OMPI_V_GEN) $(sizeof_pl) \ --impl=$@ --ierror=optional --pmpi \ --maxrank=$(OMPI_FORTRAN_MAX_ARRAY_RANK) \ @@ -110,34 +108,25 @@ profile/psizeof_f08.f90: --complex4=$(OMPI_HAVE_FORTRAN_COMPLEX4) \ --complex32=$(OMPI_HAVE_FORTRAN_COMPLEX32) -CLEANFILES += sizeof_f08.h sizeof_f08.f90 profile/psizeof_f08.f90 +CLEANFILES += sizeof_f08.h sizeof_f08.f90 psizeof_f08.f90 mpi_api_files = \ abort_f08.F90 \ - accumulate_f08.F90 \ add_error_class_f08.F90 \ add_error_code_f08.F90 \ add_error_string_f08.F90 \ aint_add_f08.F90 \ aint_diff_f08.F90 \ - allgather_f08.F90 \ allgather_init_f08.F90 \ - allgatherv_f08.F90 \ allgatherv_init_f08.F90 \ alloc_mem_f08.F90 \ - allreduce_f08.F90 \ allreduce_init_f08.F90 \ - alltoall_f08.F90 \ alltoall_init_f08.F90 \ - alltoallv_f08.F90 \ alltoallv_init_f08.F90 \ - alltoallw_f08.F90 \ alltoallw_init_f08.F90 \ barrier_f08.F90 \ barrier_init_f08.F90 \ - bcast_f08.F90 \ bcast_init_f08.F90 \ - bsend_f08.F90 \ bsend_init_f08.F90 \ buffer_attach_f08.F90 \ buffer_detach_f08.F90 \ @@ -255,7 +244,6 @@ mpi_api_files = \ file_write_at_all_end_f08.F90 \ file_write_at_all_f08.F90 \ file_write_at_f08.F90 \ - file_write_f08.F90 \ file_write_ordered_begin_f08.F90 \ file_write_ordered_end_f08.F90 \ file_write_ordered_f08.F90 \ @@ -334,7 +322,6 @@ mpi_api_files = \ intercomm_create_from_groups_f08.F90 \ intercomm_merge_f08.F90 \ iprobe_f08.F90 \ - irecv_f08.F90 \ ireduce_f08.F90 \ ireduce_scatter_f08.F90 \ ireduce_scatter_block_f08.F90 \ @@ -342,7 +329,6 @@ mpi_api_files = \ iscan_f08.F90 \ iscatter_f08.F90 \ iscatterv_f08.F90 \ - isend_f08.F90 \ isendrecv_f08.F90 \ isendrecv_replace_f08.F90 \ issend_f08.F90 \ @@ -380,9 +366,7 @@ mpi_api_files = \ put_f08.F90 \ query_thread_f08.F90 \ raccumulate_f08.F90 \ - recv_f08.F90 \ recv_init_f08.F90 \ - reduce_f08.F90 \ reduce_init_f08.F90 \ reduce_local_f08.F90 \ reduce_scatter_f08.F90 \ @@ -403,7 +387,6 @@ mpi_api_files = \ scatter_init_f08.F90 \ scatterv_f08.F90 \ scatterv_init_f08.F90 \ - send_f08.F90 \ send_init_f08.F90 \ sendrecv_f08.F90 \ sendrecv_replace_f08.F90 \ @@ -427,7 +410,6 @@ mpi_api_files = \ status_set_elements_f08.F90 \ status_set_elements_x_f08.F90 \ testall_f08.F90 \ - testany_f08.F90 \ test_cancelled_f08.F90 \ test_f08.F90 \ testsome_f08.F90 \ @@ -468,13 +450,11 @@ mpi_api_files = \ unpack_external_f08.F90 \ unpack_f08.F90 \ unpublish_name_f08.F90 \ - waitall_f08.F90 \ waitany_f08.F90 \ wait_f08.F90 \ waitsome_f08.F90 \ win_allocate_f08.F90 \ win_allocate_shared_f08.F90 \ - win_attach_f08.F90 \ win_call_errhandler_f08.F90 \ win_complete_f08.F90 \ win_create_dynamic_f08.F90 \ @@ -508,28 +488,25 @@ mpi_api_files = \ win_test_f08.F90 \ win_unlock_f08.F90 \ win_unlock_all_f08.F90 \ - win_wait_f08.F90 - -# JMS Somehow this variable substitution isn't quite working, and I -# don't have time to figure it out. So just wholesale copy the file -# list. :-( -#pmpi_api_files = $(mpi_api_files:%=profile/p%) + win_wait_f08.F90 \ + api_f08_generated.F90 lib@OMPI_LIBMPI_NAME@_usempif08_la_SOURCES = \ $(mpi_api_files) \ mpi-f08.F90 -# These are generated; do not ship them -nodist_lib@OMPI_LIBMPI_NAME@_usempif08_la_SOURCES = - if BUILD_FORTRAN_SIZEOF SIZEOF_H = sizeof_f08.h -nodist_lib@OMPI_LIBMPI_NAME@_usempif08_la_SOURCES += \ +nodist_lib@OMPI_LIBMPI_NAME@_usempif08_la_SOURCES = \ sizeof_f08.h \ sizeof_f08.f90 \ - profile/psizeof_f08.f90 + psizeof_f08.f90 endif +lib@OMPI_LIBMPI_NAME@_usempif08_la_FCFLAGS = \ + $(AM_FCFLAGS) \ + -DOMPI_BUILD_MPI_PROFILING=0 + # # Include the mpi_f08-based MPI extensions in libmpi_usempif08, too. # @@ -539,13 +516,20 @@ endif # lib@OMPI_LIBMPI_NAME@_usempif08_la_LIBADD = \ - profile/libmpi_usempif08_pmpi.la \ + lib@OMPI_LIBMPI_NAME@_usempif08_profile.la \ $(OMPI_MPIEXT_USEMPIF08_LIBS) \ $(top_builddir)/ompi/mpi/fortran/mpif-h/lib@OMPI_LIBMPI_NAME@_mpifh.la \ $(top_builddir)/ompi/lib@OMPI_LIBMPI_NAME@.la \ mod/libusempif08_internal_modules.la \ base/libusempif08_ccode.la -lib@OMPI_LIBMPI_NAME@_usempif08_la_DEPENDENCIES = $(module_sentinel_files) + +# +# Make sure to build the profile library before this library, since adding it +# to LIBADD doesn't enforce any ordering +# +lib@OMPI_LIBMPI_NAME@_usempif08_la_DEPENDENCIES = \ + $(module_sentinel_files) \ + lib@OMPI_LIBMPI_NAME@_usempif08_profile.la lib@OMPI_LIBMPI_NAME@_usempif08_la_LDFLAGS = -version-info $(libmpi_usempif08_so_version) # @@ -558,6 +542,44 @@ mpi_api_lo_files = $(mpi_api_files:.F90=.lo) $(mpi_api_lo_files): bindings/libforce_usempif08_internal_bindings_to_be_built.la mpi-f08.lo: $(module_sentinel_files) $(SIZEOF_H) +mpi-f08.F90: $(SIZEOF_H) + +# +# Profiling interface +# + +lib@OMPI_LIBMPI_NAME@_usempif08_profile_la_SOURCES = \ + $(mpi_api_files) + +lib@OMPI_LIBMPI_NAME@_usempif08_profile_la_FCFLAGS = \ + $(AM_FCFLAGS) \ + -DOMPI_BUILD_MPI_PROFILING=1 + + +# +# Generate the Fortran bindings and C wrapper functions for bindings with a +# *.in template. +# + +if OMPI_GENERATE_BINDINGS + +include Makefile.prototype_files + +api_f08_generated.F90: $(prototype_files) + $(OMPI_V_GEN) $(PYTHON) $(top_srcdir)/ompi/mpi/bindings/bindings.py \ + --builddir $(abs_top_builddir) \ + --srcdir $(abs_top_srcdir) \ + --output $(abs_builddir)/$@ \ + fortran \ + code \ + --lang fortran \ + --prototype-files $(ready_prototype_files) + +EXTRA_DIST = $(extra_dist_prototype_files) + +# Delete generated file on maintainer-clean +MAINTAINERCLEANFILES = api_f08_generated.F90 +endif ########################################################################### diff --git a/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files b/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files new file mode 100644 index 00000000000..d2eab254506 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files @@ -0,0 +1,276 @@ +# +# Shared list of prototype files to avoid listing dependencies multiple times. +# + +non_ts_prototype_files = \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/waitall.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/testany.c.in + +prototype_files = \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/accumulate_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/bsend_init_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/bsend_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/buffer_attach_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/compare_and_swap_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/fetch_and_op_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_iread_all_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_iread_at_all_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_iread_at_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_iread_shared_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_iread_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_iwrite_all_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_all_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_iwrite_shared_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_iwrite_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_read_all_begin_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_read_all_end_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_read_all_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_begin_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_end_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_read_at_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_begin_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_end_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_read_shared_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_read_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_all_begin_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_all_end_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_all_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_begin_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_end_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_at_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_begin_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_end_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_shared_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/free_mem_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/f_sync_reg_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/get_accumulate_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/get_address_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/get_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/iallgather_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/iallgatherv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/iallreduce_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ialltoall_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ialltoallv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ialltoallw_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ibcast_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ibsend_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/iexscan_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/igather_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/igatherv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/imrecv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ineighbor_allgather_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ineighbor_allgatherv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ineighbor_alltoall_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ineighbor_alltoallv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ineighbor_alltoallw_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/irecv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_block_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ireduce_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/irsend_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/iscan_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/iscatter_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/iscatterv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/isendrecv_replace_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/isendrecv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/issend_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/mrecv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/pack_external_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/pack_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/put_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/raccumulate_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/recv_init_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/recv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/rget_accumulate_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/rget_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/rput_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/rsend_init_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/rsend_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/send_init_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/sendrecv_replace_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/sendrecv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/send_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ssend_init_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/ssend_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/unpack_external_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/unpack_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/win_attach_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/win_create_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/win_detach_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/allgather_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/allgatherv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/allreduce_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/alltoall_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/alltoallv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/alltoallw_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/bcast_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/bindings.h \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/exscan_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/gather_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/gatherv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/reduce_local_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/reduce_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/scan_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/scatter_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/scatterv_ts.c.in \ + $(non_ts_prototype_files) + +# Temporary variable while converting files. +ready_prototype_files = \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/accumulate_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/allgather_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/allgatherv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/allreduce_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/alltoall_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/alltoallv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/alltoallw_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/bcast_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/bsend_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/send_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/recv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/isend_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/irecv_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/file_write_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/reduce_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/waitall.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/win_attach_ts.c.in \ + $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/testany.c.in + +# TODO: Is there any way to get EXTRA_DIST to work with absolute paths? Or, +# better yet, is there some way to make these dependencies a little +# easier to work with? +extra_dist_prototype_files = \ + accumulate_ts.c.in \ + bsend_init_ts.c.in \ + bsend_ts.c.in \ + buffer_attach_ts.c.in \ + compare_and_swap_ts.c.in \ + fetch_and_op_ts.c.in \ + file_iread_all_ts.c.in \ + file_iread_at_all_ts.c.in \ + file_iread_at_ts.c.in \ + file_iread_shared_ts.c.in \ + file_iread_ts.c.in \ + file_iwrite_all_ts.c.in \ + file_iwrite_at_all_ts.c.in \ + file_iwrite_at_ts.c.in \ + file_iwrite_shared_ts.c.in \ + file_iwrite_ts.c.in \ + file_read_all_begin_ts.c.in \ + file_read_all_end_ts.c.in \ + file_read_all_ts.c.in \ + file_read_at_all_begin_ts.c.in \ + file_read_at_all_end_ts.c.in \ + file_read_at_all_ts.c.in \ + file_read_at_ts.c.in \ + file_read_ordered_begin_ts.c.in \ + file_read_ordered_end_ts.c.in \ + file_read_ordered_ts.c.in \ + file_read_shared_ts.c.in \ + file_read_ts.c.in \ + file_write_all_begin_ts.c.in \ + file_write_all_end_ts.c.in \ + file_write_all_ts.c.in \ + file_write_at_all_begin_ts.c.in \ + file_write_at_all_end_ts.c.in \ + file_write_at_all_ts.c.in \ + file_write_at_ts.c.in \ + file_write_ordered_begin_ts.c.in \ + file_write_ordered_end_ts.c.in \ + file_write_ordered_ts.c.in \ + file_write_shared_ts.c.in \ + file_write_ts.c.in \ + free_mem_ts.c.in \ + f_sync_reg_ts.c.in \ + get_accumulate_ts.c.in \ + get_address_ts.c.in \ + get_ts.c.in \ + iallgather_ts.c.in \ + iallgatherv_ts.c.in \ + iallreduce_ts.c.in \ + ialltoall_ts.c.in \ + ialltoallv_ts.c.in \ + ialltoallw_ts.c.in \ + ibcast_ts.c.in \ + ibsend_ts.c.in \ + iexscan_ts.c.in \ + igather_ts.c.in \ + igatherv_ts.c.in \ + imrecv_ts.c.in \ + ineighbor_allgather_ts.c.in \ + ineighbor_allgatherv_ts.c.in \ + ineighbor_alltoall_ts.c.in \ + ineighbor_alltoallv_ts.c.in \ + ineighbor_alltoallw_ts.c.in \ + irecv_ts.c.in \ + ireduce_scatter_block_ts.c.in \ + ireduce_scatter_ts.c.in \ + ireduce_ts.c.in \ + irsend_ts.c.in \ + iscan_ts.c.in \ + iscatter_ts.c.in \ + iscatterv_ts.c.in \ + isendrecv_replace_ts.c.in \ + isendrecv_ts.c.in \ + issend_ts.c.in \ + mrecv_ts.c.in \ + pack_external_ts.c.in \ + pack_ts.c.in \ + put_ts.c.in \ + raccumulate_ts.c.in \ + recv_init_ts.c.in \ + recv_ts.c.in \ + rget_accumulate_ts.c.in \ + rget_ts.c.in \ + rput_ts.c.in \ + rsend_init_ts.c.in \ + rsend_ts.c.in \ + send_init_ts.c.in \ + sendrecv_replace_ts.c.in \ + sendrecv_ts.c.in \ + send_ts.c.in \ + ssend_init_ts.c.in \ + ssend_ts.c.in \ + unpack_external_ts.c.in \ + unpack_ts.c.in \ + win_attach_ts.c.in \ + win_create_ts.c.in \ + win_detach_ts.c.in \ + allgather_ts.c.in \ + allgatherv_ts.c.in \ + allreduce_ts.c.in \ + alltoall_ts.c.in \ + alltoallv_ts.c.in \ + alltoallw_ts.c.in \ + bcast_ts.c.in \ + bindings.h \ + exscan_ts.c.in \ + gather_ts.c.in \ + gatherv_ts.c.in \ + neighbor_allgather_ts.c.in \ + neighbor_allgatherv_ts.c.in \ + neighbor_alltoall_ts.c.in \ + neighbor_alltoallv_ts.c.in \ + neighbor_alltoallw_ts.c.in \ + reduce_local_ts.c.in \ + reduce_scatter_block_ts.c.in \ + reduce_scatter_ts.c.in \ + reduce_ts.c.in \ + scan_ts.c.in \ + scatter_ts.c.in \ + scatterv_ts.c.in \ + waitall.c.in \ + testany.c.in diff --git a/ompi/mpi/fortran/use-mpi-f08/accumulate_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/accumulate_ts.c.in new file mode 100644 index 00000000000..5d9924d350d --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/accumulate_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID accumulate(BUFFER x, COUNT origin_count, + DATATYPE origin_datatype, RANK target_rank, + AINT target_disp, COUNT target_count, + DATATYPE target_datatype, OP op, WIN win) +{ + int c_ierr; + + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + MPI_Op c_op = PMPI_Op_f2c(*op); + char *origin_addr = OMPI_CFI_BASE_ADDR(x); + int c_origin_count = OMPI_INT_2_FINT(*origin_count); + + OMPI_CFI_2_C(x, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + OMPI_FINT_2_INT(*target_count), + c_target_datatype, c_op, c_win); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/allgather_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/allgather_f08.F90 deleted file mode 100644 index ed2aefbad59..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/allgather_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- 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 "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Allgather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_allgather_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_allgather_f(sendbuf,sendcount,sendtype%MPI_VAL,& - recvbuf,recvcount,recvtype%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Allgather_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/allgather_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/allgather_ts.c.in new file mode 100644 index 00000000000..6ef928593eb --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/allgather_ts.c.in @@ -0,0 +1,68 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID allgather(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT x2, COUNT recvcount, DATATYPE recvtype, + COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_sendcount = 0; + MPI_Datatype c_sendtype = NULL, c_senddatatype = NULL; + MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype); + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + sendbuf = MPI_IN_PLACE; + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_senddatatype, + recvbuf, + OMPI_FINT_2_INT(*recvcount), + c_recvtype, c_comm); + + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/allgatherv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/allgatherv_f08.F90 deleted file mode 100644 index 260b89a986b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/allgatherv_f08.F90 +++ /dev/null @@ -1,33 +0,0 @@ -! -*- 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 "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Allgatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,& - displs,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_allgatherv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_allgatherv_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcounts,& - displs,recvtype%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Allgatherv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/allgatherv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/allgatherv_ts.c.in new file mode 100644 index 00000000000..e9a9329d6f5 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/allgatherv_ts.c.in @@ -0,0 +1,90 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID allgatherv(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT x2, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_sendcount = 0; + MPI_Datatype c_sendtype = NULL, c_senddatatype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + int size = 0; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_displs = NULL; + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + if (OMPI_COMM_IS_INTER(c_comm)) { + size = ompi_comm_remote_size(c_comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + size = ompi_comm_size(c_comm); + if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + sendbuf = MPI_IN_PLACE; + } else { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } + + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_senddatatype, + recvbuf, + tmp_recvcounts, + tmp_displs, + c_recvtype, c_comm); + + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(displs, tmp_displs); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/allreduce_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/allreduce_f08.F90 deleted file mode 100644 index 0e98b9e171a..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/allreduce_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- 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 "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Allreduce_f08(sendbuf,recvbuf,count,datatype,op,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_allreduce_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_allreduce_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Allreduce_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/allreduce_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/allreduce_ts.c.in new file mode 100644 index 00000000000..a5a519e747b --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/allreduce_ts.c.in @@ -0,0 +1,55 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID allreduce(BUFFER x1, BUFFER_OUT x2, COUNT count, + DATATYPE datatype, OP op, COMM comm) +{ + int c_ierr; + int c_count = OMPI_FINT_2_INT(*count); + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + c_count, + c_type, c_op, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoall_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/alltoall_f08.F90 deleted file mode 100644 index f201dd2f769..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/alltoall_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- 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 "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Alltoall_f08(sendbuf,sendcount,sendtype,recvbuf,& - recvcount,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_alltoall_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_alltoall_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,& - recvcount,recvtype%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Alltoall_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoall_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoall_ts.c.in new file mode 100644 index 00000000000..81dd106afc6 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/alltoall_ts.c.in @@ -0,0 +1,63 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID alltoall(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT x2, COUNT recvcount, DATATYPE recvtype, + COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_sendtype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype); + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + int c_sendcount = 0, c_recvcount = OMPI_FINT_2_INT(*recvcount); + + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + sendbuf = MPI_IN_PLACE; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_sendtype, + recvbuf, + c_recvcount, + c_recvtype, c_comm); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/alltoallv_f08.F90 deleted file mode 100644 index 0acf0fd03a5..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/alltoallv_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- 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 "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Alltoallv_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,& - recvcounts,rdispls,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_alltoallv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_alltoallv_f(sendbuf,sendcounts,sdispls,sendtype%MPI_VAL,& - recvbuf,recvcounts,rdispls,recvtype%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Alltoallv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoallv_ts.c.in new file mode 100644 index 00000000000..d99df6fd377 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/alltoallv_ts.c.in @@ -0,0 +1,79 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID alltoallv(BUFFER x1, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE sendtype, BUFFER_OUT x2, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE recvtype, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + MPI_Datatype c_sendtype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype); + int size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm); + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @DISP_TYPE@ *tmp_sdispls = NULL; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_rdispls = NULL; + + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sdispls, tmp_sdispls, size); + } else { + sendbuf = MPI_IN_PLACE; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(rdispls, tmp_rdispls, size); + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + tmp_sendcounts, + tmp_sdispls, + c_sendtype, + recvbuf, + tmp_recvcounts, + tmp_rdispls, + c_recvtype, c_comm); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_IN_PLACE == sendbuf) { + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sdispls, tmp_sdispls); + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(rdispls, tmp_rdispls); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallw_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/alltoallw_f08.F90 deleted file mode 100644 index f63ac4842f7..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/alltoallw_f08.F90 +++ /dev/null @@ -1,42 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2013 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 "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Alltoallw_f08(sendbuf,sendcounts,sdispls,sendtypes,& - recvbuf,recvcounts,rdispls,recvtypes,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_alltoallw_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtypes(*) - TYPE(MPI_Datatype), INTENT(IN) :: recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - ! Note that we pass a scalar here for both the sendtypes and - ! recvtypes arguments, even though the real Alltoallw function - ! expects an array of integers. This is a hack: we know that - ! [send|recv]types(1)%MPI_VAL will pass the address of the first - ! integer in the array of Type(MPI_Datatype) derived types. And - ! since Type(MPI_Datatype) are exactly memory-equivalent to a - ! single INTEGER, passing the address of the first one is the same - ! as passing the address to an array of integers. To be clear: the - ! back-end ompi_alltoallw_f is expecting a pointer to an array of - ! integers. So it all works out (but is a hack :-\ ). - call ompi_alltoallw_f(sendbuf,sendcounts,sdispls,sendtypes(1)%MPI_VAL,& - recvbuf,recvcounts,rdispls,recvtypes(1)%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Alltoallw_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallw_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoallw_ts.c.in new file mode 100644 index 00000000000..f0e104c400e --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/alltoallw_ts.c.in @@ -0,0 +1,90 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID alltoallw(BUFFER x1, COUNT_ARRAY sendcounts, + DISP_ARRAY sdispls, DATATYPE_ARRAY sendtypes, + BUFFER_OUT x2, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE_ARRAY recvtypes, + COMM comm) +{ + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype *c_sendtypes = NULL, *c_recvtypes; + int size, c_ierr; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_ARRAY_NAME_DECL(sendcounts); + OMPI_ARRAY_NAME_DECL(sdispls); + OMPI_ARRAY_NAME_DECL(recvcounts); + OMPI_ARRAY_NAME_DECL(rdispls); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm); + + if (!OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype)); + OMPI_ARRAY_FINT_2_INT(sendcounts, size); + OMPI_ARRAY_FINT_2_INT(sdispls, size); + for (int i=0; i + +#if OMPI_FORTRAN_HAVE_TS + +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; +} + +static void copy(CFI_dim_t *dim, int rank, char * base, char **dest, size_t len) { + for (CFI_index_t i=0; iextent; i++) { + if (rank > 1) { + copy(dim-1, rank-1, base, dest, len); + } else { + memcpy(*dest, base, len); + *dest += len; + } + base += dim->sm; + } +} + +int ompi_ts_copy(CFI_cdesc_t *cdesc, char *buffer) { + copy(&cdesc->dim[cdesc->rank - 1], cdesc->rank, cdesc->base_addr, &buffer, cdesc->elem_len); + return OMPI_SUCCESS; +} + +static void copy_back(CFI_dim_t *dim, int rank, char * base, char **source, size_t len) { + for (CFI_index_t i=0; iextent; i++) { + if (rank > 1) { + copy_back(dim-1, rank-1, base, source, len); + } else { + memcpy(base, *source, len); + *source += len; + } + base += dim->sm; + } +} + +int ompi_ts_copy_back(char *buffer, CFI_cdesc_t *cdesc) { + copy_back(&cdesc->dim[cdesc->rank - 1], cdesc->rank, cdesc->base_addr, &buffer, cdesc->elem_len); + return OMPI_SUCCESS; +} + +size_t ompi_ts_size(CFI_cdesc_t *cdesc) { + size_t res = cdesc->elem_len; + for (int i=0; irank; i++) { + res *= cdesc->dim[i].extent; + } + return res; +} +#endif /* OMPI_FORTRAN_HAVE_TS */ diff --git a/ompi/mpi/fortran/use-mpi-f08/base/ts.h b/ompi/mpi/fortran/use-mpi-f08/base/ts.h new file mode 100644 index 00000000000..66670f6ba08 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/base/ts.h @@ -0,0 +1,158 @@ +/* -*- 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 "ompi/datatype/ompi_datatype.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" + +#if OMPI_FORTRAN_HAVE_TS + +#include + +#define OMPI_CFI_BUFFER CFI_cdesc_t + +extern int ompi_ts_create_datatype(CFI_cdesc_t *cdesc, int oldcount, MPI_Datatype oldtype, MPI_Datatype *newtype); + +extern size_t ompi_ts_size(CFI_cdesc_t *cdesc); + +extern int ompi_ts_copy_back(char *buffer, CFI_cdesc_t *cdesc); + +extern int ompi_ts_copy(CFI_cdesc_t *cdesc, char *buffer); + +#define OMPI_CFI_BASE_ADDR(x) (x)->base_addr + +#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) { \ + count = 1; \ + } \ + } else { \ + rc = MPI_SUCCESS; \ + } \ + } while (0) + +#define OMPI_CFI_2_C_ALLOC(x, buffer, count, type, datatype, rc) \ + do { \ + datatype = type; \ + if (x->rank != 0 && !CFI_is_contiguous(x)) { \ + size_t size = ompi_ts_size(x); \ + buffer = malloc(size); \ + if (NULL == buffer) { \ + rc = MPI_ERR_NO_MEM; \ + } else { \ + rc = MPI_SUCCESS; \ + } \ + } else { \ + buffer = x->base_addr; \ + rc = MPI_SUCCESS; \ + } \ + } while (0) + +#define OMPI_CFI_2_C_COPY(x, buffer, count, type, datatype, rc) \ + do { \ + datatype = type; \ + if (x->rank != 0 && !CFI_is_contiguous(x)) { \ + size_t size = ompi_ts_size(x); \ + buffer = malloc(size); \ + if (NULL == buffer) { \ + rc = MPI_ERR_NO_MEM; \ + } else { \ + rc = ompi_ts_copy(x, buffer); \ + } \ + } else { \ + buffer = x->base_addr; \ + rc = MPI_SUCCESS; \ + } \ + } while (0) + +#define OMPI_C_2_CFI_FREE(x, buffer, count, type, datatype, rc) \ + do { \ + if (buffer != x->base_addr) { \ + free(buffer); \ + } \ + if (type != datatype) { \ + rc = PMPI_Type_free(&datatype); \ + } \ + } while (0) + +#define OMPI_C_2_CFI_COPY(x, buffer, count, type, datatype, rc) \ + do { \ + if (buffer != x->base_addr) { \ + rc = ompi_ts_copy_back(buffer, x); \ + free(buffer); \ + } \ + if (type != datatype) { \ + rc = PMPI_Type_free(&datatype); \ + } \ + } 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) + +#else + +/* + * Macros for compilers not supporting TS 29113. + */ + +#define OMPI_CFI_BUFFER char + +#define OMPI_CFI_BASE_ADDR(x) (x) + +#define OMPI_CFI_2_C(x, count, type, datatype, rc) \ + do { \ + datatype = type; \ + rc = MPI_SUCCESS; \ + } while (0) + +#define OMPI_CFI_2_C_ALLOC(x, buffer, count, type, datatype, rc) \ + do { \ + datatype = type; \ + buffer = x; \ + rc = MPI_SUCCESS; \ + } while (0) + +#define OMPI_CFI_2_C_COPY(x, buffer, count, type, datatype, rc) \ + do { \ + datatype = type; \ + buffer = x; \ + rc = MPI_SUCCESS; \ + } while (0) + +#define OMPI_C_2_CFI_FREE(x, buffer, count, type, datatype, rc) \ + do {} while (0) + +#define OMPI_C_2_CFI_COPY(x, buffer, count, type, datatype, rc) \ + do {} while (0) + +#define OMPI_CFI_IS_CONTIGUOUS(x) 1 + +#define OMPI_CFI_CHECK_CONTIGUOUS(x, rc) \ + do { \ + rc = MPI_SUCCESS; \ + } while (0) +#endif /* OMPI_FORTRAN_HAVE_TS */ + +#define OMPI_COUNT_CONVERT(fcount) diff --git a/ompi/mpi/fortran/use-mpi-f08/bcast_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/bcast_f08.F90 deleted file mode 100644 index 1a5e5001411..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/bcast_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- 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 (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Bcast_f08(buffer,count,datatype,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_bcast_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE :: buffer - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_bcast_f(buffer,count,datatype%MPI_VAL,root,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Bcast_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/bcast_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/bcast_ts.c.in new file mode 100644 index 00000000000..a7cccab1353 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/bcast_ts.c.in @@ -0,0 +1,52 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID bcast(BUFFER_OUT x, COUNT count, DATATYPE datatype, + RANK root, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_datatype = NULL, c_type = NULL; + int c_root = OMPI_FINT_2_INT(*root); + void *buffer = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + if (OMPI_COMM_IS_INTRA(c_comm) || MPI_PROC_NULL != c_root) { + c_type = PMPI_Type_f2c(*datatype); + c_count = (@COUNT_TYPE@) *count; + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buffer), + c_count, + c_datatype, + c_root, + c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/bindings.h b/ompi/mpi/fortran/use-mpi-f08/bindings.h new file mode 100644 index 00000000000..7452a5e9bd1 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/bindings.h @@ -0,0 +1,219 @@ +/* + * Copyright (c) 2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#ifndef OMPI_CDESC_BINDINGS_H +#define OMPI_CDESC_BINDINGS_H + +#include "ompi_config.h" + +#include "ts.h" + +#include "mpi.h" + +void ompi_bsend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *ierr); + +void ompi_bsend_init_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_buffer_attach_ts(CFI_cdesc_t *x, MPI_Fint *size, MPI_Fint *ierr); + +void ompi_ibsend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_irecv_ts(CFI_cdesc_t *x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_irsend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_isend_ts(CFI_cdesc_t *x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_issend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_recv_ts(CFI_cdesc_t *x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *status, MPI_Fint *ierr); + +void ompi_recv_init_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_rsend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *ierr); + +void ompi_rsend_init_ts(CFI_cdesc_t* x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *dest, + MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_send_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_sendrecv_ts(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + MPI_Fint *dest, MPI_Fint *sendtag, CFI_cdesc_t* x2, + MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *source, MPI_Fint *recvtag, MPI_Fint *comm, + MPI_Fint *status, MPI_Fint *ierr); + +void ompi_sendrecv_replace_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *sendtag, + MPI_Fint *source, MPI_Fint *recvtag, + MPI_Fint *comm, MPI_Fint *status, MPI_Fint *ierr); + +void ompi_send_init_ts(CFI_cdesc_t *x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_ssend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_ssend_init_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, + MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr); + +void ompi_get_address_ts(CFI_cdesc_t *x, MPI_Aint *address, MPI_Fint *ierr); + +void ompi_pack_ts(CFI_cdesc_t* x1, MPI_Fint *incount, MPI_Fint *datatype, + CFI_cdesc_t* x2, MPI_Fint *outsize, MPI_Fint *position, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_pack_external_ts(char *datarep, CFI_cdesc_t* x1, MPI_Fint *incount, + MPI_Fint *datatype, CFI_cdesc_t* x2, + MPI_Aint *outsize, MPI_Aint *position, + MPI_Fint *ierr, int datarep_len); + +void ompi_unpack_ts(CFI_cdesc_t* x1, MPI_Fint *insize, MPI_Fint *position, + CFI_cdesc_t* x2, MPI_Fint *outcount, MPI_Fint *datatype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_unpack_external_ts(char *datarep, CFI_cdesc_t* x1, MPI_Aint *insize, + MPI_Aint *position, CFI_cdesc_t* x2, + MPI_Fint *outcount, MPI_Fint *datatype, + MPI_Fint *ierr, int datarep_len); + +void ompi_allgather_ts(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t* x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_allgatherv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, MPI_Fint *displs, + MPI_Fint *recvtype, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_allreduce_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, + MPI_Fint *ierr); + +void ompi_alltoall_ts(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t* x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_alltoallv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, MPI_Fint *sdispls, + MPI_Fint *sendtype, CFI_cdesc_t *x2, MPI_Fint *recvcounts, + MPI_Fint *rdispls, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_alltoallw_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, + MPI_Fint *sdispls, MPI_Fint *sendtypes, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, + MPI_Fint *rdispls, MPI_Fint *recvtypes, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_bcast_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *root, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_exscan_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, + MPI_Fint *ierr); + +void ompi_gather_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *root, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_gatherv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, MPI_Fint *displs, + MPI_Fint *recvtype, MPI_Fint *root, MPI_Fint *comm, + MPI_Fint *ierr); + +void ompi_reduce_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, + MPI_Fint *root, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_reduce_local_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *ierr); + +void ompi_reduce_scatter_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, + MPI_Fint *recvcounts, MPI_Fint *datatype, + MPI_Fint *op, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_reduce_scatter_block_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, + MPI_Fint *recvcount, MPI_Fint *datatype, + MPI_Fint *op, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_scan_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, + MPI_Fint *ierr); + +void ompi_scatter_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, + MPI_Fint *sendtype, CFI_cdesc_t *x2, + MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *root, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_scatterv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, + MPI_Fint *displs, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, + MPI_Fint *recvtype, MPI_Fint *root, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_free_mem_ts(CFI_cdesc_t *x, MPI_Fint *ierr); + +void ompi_f_sync_reg_ts(CFI_cdesc_t *x); + +void ompi_imrecv_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *message, MPI_Fint *request, MPI_Fint *ierr); + +void ompi_mrecv_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *message, MPI_Fint *status, MPI_Fint *ierr); + +void ompi_neighbor_allgather_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_neighbor_allgatherv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, MPI_Fint *displs, + MPI_Fint *recvtype, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_neighbor_alltoall_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_neighbor_alltoallv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, MPI_Fint *sdispls, + MPI_Fint *sendtype, CFI_cdesc_t *x2, MPI_Fint *recvcounts, + MPI_Fint *rdispls, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_neighbor_alltoallw_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, + MPI_Aint *sdispls, MPI_Fint *sendtypes, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, + MPI_Aint *rdispls, MPI_Fint *recvtypes, + MPI_Fint *comm, MPI_Fint *ierr); + +#endif /* OMPI_CDESC_BINDINGS_H */ diff --git a/ompi/mpi/fortran/use-mpi-f08/bsend_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/bsend_f08.F90 deleted file mode 100644 index d35900bacc1..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/bsend_f08.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! -*- 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 "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Bsend_f08(buf,count,datatype,dest,tag,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_bsend_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_bsend_f(buf,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Bsend_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/bsend_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/bsend_init_ts.c.in new file mode 100644 index 00000000000..a0e740a318a --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/bsend_init_ts.c.in @@ -0,0 +1,61 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Bsend_init"; + +void ompi_bsend_init_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Bsend_init(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, + OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/bsend_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/bsend_ts.c.in new file mode 100644 index 00000000000..dce909e8f33 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/bsend_ts.c.in @@ -0,0 +1,45 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID bsend(BUFFER x, COUNT count, DATATYPE datatype, RANK dest, + TAG tag, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/buffer_attach_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/buffer_attach_ts.c.in new file mode 100644 index 00000000000..207566b66cb --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/buffer_attach_ts.c.in @@ -0,0 +1,40 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" + +static const char FUNC_NAME[] = "MPI_Buffer_attach"; + +void ompi_buffer_attach_ts(CFI_cdesc_t *x, MPI_Fint *size, MPI_Fint *ierr) +{ + int c_ierr; + if (OMPI_CFI_IS_CONTIGUOUS(x)) { + c_ierr = PMPI_Buffer_attach(OMPI_CFI_BASE_ADDR(x), OMPI_FINT_2_INT(*size)); + } else { + c_ierr = MPI_ERR_BUFFER; + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/compare_and_swap_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/compare_and_swap_ts.c.in new file mode 100644 index 00000000000..3047e3b678a --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/compare_and_swap_ts.c.in @@ -0,0 +1,67 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/win/win.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Compare_and_swap"; + +void ompi_compare_and_swap_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, CFI_cdesc_t *x3, + MPI_Fint *datatype, MPI_Fint *target_rank, MPI_Aint *target_disp, + MPI_Fint *win, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_datatype = PMPI_Type_f2c(*datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + char *origin_addr = OMPI_CFI_BASE_ADDR(x1), *compare_addr = OMPI_CFI_BASE_ADDR(x2), *result_addr = OMPI_CFI_BASE_ADDR(x3); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x3, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + c_ierr = PMPI_Compare_and_swap(OMPI_F2C_BOTTOM(origin_addr), + OMPI_F2C_BOTTOM(compare_addr), + OMPI_F2C_BOTTOM(result_addr), + c_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, c_win); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/exscan_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/exscan_ts.c.in new file mode 100644 index 00000000000..6081fd6e5cc --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/exscan_ts.c.in @@ -0,0 +1,64 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Exscan"; + +void ompi_exscan_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM (sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM (recvbuf); + + c_ierr = PMPI_Exscan(sendbuf, recvbuf, + OMPI_FINT_2_INT(*count), + c_type, c_op, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/f_sync_reg_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/f_sync_reg_ts.c.in new file mode 100644 index 00000000000..a20db111458 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/f_sync_reg_ts.c.in @@ -0,0 +1,32 @@ +/* + * 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) 2012 University of Oregon. All rights reserved. + * Copyright (c) 2015-2019 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/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +void ompi_f_sync_reg_ts(CFI_cdesc_t *x) +{ + /* This is a noop in C to disable potential Fortran optimizations. */ + return; +} diff --git a/ompi/mpi/fortran/use-mpi-f08/fetch_and_op_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/fetch_and_op_ts.c.in new file mode 100644 index 00000000000..1cb0b28659d --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/fetch_and_op_ts.c.in @@ -0,0 +1,62 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/win/win.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Fetch_and_op"; + +void ompi_fetch_and_op_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *datatype, + MPI_Fint *target_rank, MPI_Aint *target_disp, + MPI_Fint *op, MPI_Fint *win, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_datatype = PMPI_Type_f2c(*datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + MPI_Op c_op = PMPI_Op_f2c(*op); + char *origin_addr = OMPI_CFI_BASE_ADDR(x1), *result_addr = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + c_ierr = PMPI_Fetch_and_op(OMPI_F2C_BOTTOM(origin_addr), + OMPI_F2C_BOTTOM(result_addr), + c_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, c_op, c_win); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iread_all_ts.c.in new file mode 100644 index 00000000000..bf253f304d9 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iread_all_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_iread_all"; + +void ompi_file_iread_all_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_iread_all(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, &c_request); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_at_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iread_at_all_ts.c.in new file mode 100644 index 00000000000..3a5fea11386 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iread_at_all_ts.c.in @@ -0,0 +1,62 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_iread_at_all"; + +void ompi_file_iread_at_all_ts(MPI_Fint *fh, MPI_Offset *offset, + CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_iread_at_all(c_fh, (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_at_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iread_at_ts.c.in new file mode 100644 index 00000000000..c5c3a7d6912 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iread_at_ts.c.in @@ -0,0 +1,62 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_iread_at"; + +void ompi_file_iread_at_ts(MPI_Fint *fh, MPI_Offset *offset, + CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_iread_at(c_fh, (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_shared_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iread_shared_ts.c.in new file mode 100644 index 00000000000..f371a1a2817 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iread_shared_ts.c.in @@ -0,0 +1,62 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_iread_shared"; + +void ompi_file_iread_shared_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *request, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_iread_shared(c_fh, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iread_ts.c.in new file mode 100644 index 00000000000..64c688128fc --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iread_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_iread"; + +void ompi_file_iread_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_iread(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, &c_request); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_all_ts.c.in new file mode 100644 index 00000000000..16bc37dda93 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_all_ts.c.in @@ -0,0 +1,59 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_iwrite_all"; + +void ompi_file_iwrite_all_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_iwrite_all(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_all_ts.c.in new file mode 100644 index 00000000000..94f7efc2fa0 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_all_ts.c.in @@ -0,0 +1,63 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_iwrite_at_all"; + +void ompi_file_iwrite_at_all_ts(MPI_Fint *fh, MPI_Offset *offset, CFI_cdesc_t *x, + MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_iwrite_at_all(c_fh, (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_ts.c.in new file mode 100644 index 00000000000..2fe3b3493eb --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_ts.c.in @@ -0,0 +1,63 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_iwrite_at"; + +void ompi_file_iwrite_at_ts(MPI_Fint *fh, MPI_Offset *offset, CFI_cdesc_t *x, + MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_iwrite_at(c_fh, (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_shared_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_shared_ts.c.in new file mode 100644 index 00000000000..bbcd085b8ed --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_shared_ts.c.in @@ -0,0 +1,63 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_iwrite_shared"; + +void ompi_file_iwrite_shared_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *request, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_iwrite_shared(c_fh, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_ts.c.in new file mode 100644 index 00000000000..662168e95e6 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_iwrite"; + +void ompi_file_iwrite_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_iwrite(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_all_begin_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_all_begin_ts.c.in new file mode 100644 index 00000000000..63f50c7fec3 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_all_begin_ts.c.in @@ -0,0 +1,56 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_read_all_begin"; + +void ompi_file_read_all_begin_ts(MPI_Fint *fh, CFI_cdesc_t *x, + MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_read_all_begin(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_all_end_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_all_end_ts.c.in new file mode 100644 index 00000000000..71d01c035d3 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_all_end_ts.c.in @@ -0,0 +1,46 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +void ompi_file_read_all_end_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *status, + MPI_Fint *ierr) +{ + int c_ierr; + void *buf = OMPI_CFI_BASE_ADDR(x); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + MPI_File c_fh = PMPI_File_f2c(*fh); + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_read_all_end(c_fh, buf, c_status); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_all_ts.c.in new file mode 100644 index 00000000000..56ad69d18c0 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_all_ts.c.in @@ -0,0 +1,62 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_read_all"; + +void ompi_file_read_all_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *status, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_read_all(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_begin_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_begin_ts.c.in new file mode 100644 index 00000000000..1dc26bbd622 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_begin_ts.c.in @@ -0,0 +1,58 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_read_at_all_begin"; + +void ompi_file_read_at_all_begin_ts(MPI_Fint *fh, MPI_Offset *offset, + CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_read_at_all_begin(c_fh, + (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_end_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_end_ts.c.in new file mode 100644 index 00000000000..dae4f684219 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_end_ts.c.in @@ -0,0 +1,45 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +void ompi_file_read_at_all_end_ts(MPI_Fint *fh, CFI_cdesc_t *x, + MPI_Fint *status, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + void *buf = OMPI_CFI_BASE_ADDR(x); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_read_at_all_end(c_fh, buf, c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_ts.c.in new file mode 100644 index 00000000000..957251076f5 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_ts.c.in @@ -0,0 +1,67 @@ +/* + * 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_read_at_all"; + +void ompi_file_read_at_all_ts(MPI_Fint *fh, MPI_Offset *offset, + CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *status, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_read_at_all(c_fh, + (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_at_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_at_ts.c.in new file mode 100644 index 00000000000..5eacf167b1d --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_at_ts.c.in @@ -0,0 +1,65 @@ +/* + * 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_read_at"; + +void ompi_file_read_at_ts(MPI_Fint *fh, MPI_Offset *offset, CFI_cdesc_t *x, + MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *status, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_read_at(c_fh, + (MPI_Offset) *offset, + buf, + c_count, + c_datatype, c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_begin_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_begin_ts.c.in new file mode 100644 index 00000000000..14542d01468 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_begin_ts.c.in @@ -0,0 +1,55 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_read_ordered_begin"; + +void ompi_file_read_ordered_begin_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_read_ordered_begin(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_end_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_end_ts.c.in new file mode 100644 index 00000000000..eeaba0df1e3 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_end_ts.c.in @@ -0,0 +1,45 @@ +/* + * 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +void ompi_file_read_ordered_end_ts(MPI_Fint *fh, CFI_cdesc_t *x, + MPI_Fint *status, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + void *buf = OMPI_CFI_BASE_ADDR(x); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_read_ordered_end(c_fh, buf, c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_ts.c.in new file mode 100644 index 00000000000..1b253e4a01a --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_ts.c.in @@ -0,0 +1,65 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_read_ordered"; + +void ompi_file_read_ordered_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *status, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_read_ordered(c_fh, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_shared_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_shared_ts.c.in new file mode 100644 index 00000000000..56b11771f33 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_shared_ts.c.in @@ -0,0 +1,65 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_read_shared"; + +void ompi_file_read_shared_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *status, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_read_shared(c_fh, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_ts.c.in new file mode 100644 index 00000000000..05316e64974 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_ts.c.in @@ -0,0 +1,62 @@ +/* + * 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_read"; + +void ompi_file_read_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *status, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_read(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_all_begin_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_all_begin_ts.c.in new file mode 100644 index 00000000000..016b897d090 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_all_begin_ts.c.in @@ -0,0 +1,56 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_write_all_begin"; + +void ompi_file_write_all_begin_ts(MPI_Fint *fh, CFI_cdesc_t *x, + MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_write_all_begin(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_all_end_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_all_end_ts.c.in new file mode 100644 index 00000000000..f0e23a1eb69 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_all_end_ts.c.in @@ -0,0 +1,46 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +void ompi_file_write_all_end_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *status, + MPI_Fint *ierr) +{ + int c_ierr; + void *buf = x->base_addr; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + MPI_File c_fh = PMPI_File_f2c(*fh); + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_write_all_end(c_fh, buf, c_status); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_all_ts.c.in new file mode 100644 index 00000000000..2072729f64b --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_all_ts.c.in @@ -0,0 +1,62 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_write_all"; + +void ompi_file_write_all_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *status, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_write_all(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_begin_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_begin_ts.c.in new file mode 100644 index 00000000000..92296b8d6f1 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_begin_ts.c.in @@ -0,0 +1,59 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_write_at_all_begin"; + +void ompi_file_write_at_all_begin_ts(MPI_Fint *fh, MPI_Offset *offset, + CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + + c_ierr = PMPI_File_write_at_all_begin(c_fh, + (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_end_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_end_ts.c.in new file mode 100644 index 00000000000..a88f106ac96 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_end_ts.c.in @@ -0,0 +1,46 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +void ompi_file_write_at_all_end_ts(MPI_Fint *fh, CFI_cdesc_t *x, + MPI_Fint *status, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + void *buf = OMPI_CFI_BASE_ADDR(x); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_write_at_all_end(c_fh, buf, c_status); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_ts.c.in new file mode 100644 index 00000000000..33c695e4ee5 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_ts.c.in @@ -0,0 +1,67 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_write_at_all"; + +void ompi_file_write_at_all_ts(MPI_Fint *fh, MPI_Offset *offset, + CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *status, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_write_at_all(c_fh, + (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_at_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_at_ts.c.in new file mode 100644 index 00000000000..397dd217794 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_at_ts.c.in @@ -0,0 +1,65 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_write_at"; + +void ompi_file_write_at_ts(MPI_Fint *fh, MPI_Offset *offset, + CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *status, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_write_at(c_fh, + (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_f08.F90 deleted file mode 100644 index 8dd3c49496d..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- 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 "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_write_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_f(fh%MPI_VAL,buf,count,& - datatype%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_begin_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_begin_ts.c.in new file mode 100644 index 00000000000..0210e36e58e --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_begin_ts.c.in @@ -0,0 +1,56 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_write_ordered_begin"; + +void ompi_file_write_ordered_begin_ts(MPI_Fint *fh, CFI_cdesc_t *x, + MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_File_write_ordered_begin(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_end_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_end_ts.c.in new file mode 100644 index 00000000000..d957ac4c329 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_end_ts.c.in @@ -0,0 +1,46 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +void ompi_file_write_ordered_end_ts(MPI_Fint *fh, CFI_cdesc_t *x, + MPI_Fint *status, MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + void *buf = OMPI_CFI_BASE_ADDR(x); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_write_ordered_end(c_fh, buf, c_status); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_ts.c.in new file mode 100644 index 00000000000..ec89ebef88d --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_ts.c.in @@ -0,0 +1,65 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_write_ordered"; + +void ompi_file_write_ordered_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *status, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_write_ordered(c_fh, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_shared_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_shared_ts.c.in new file mode 100644 index 00000000000..dec70fa6f89 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_shared_ts.c.in @@ -0,0 +1,65 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/file/file.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_File_write_shared"; + +void ompi_file_write_shared_ts(MPI_Fint *fh, CFI_cdesc_t *x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *status, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_write_shared(c_fh, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_ts.c.in new file mode 100644 index 00000000000..330fdd2228f --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_ts.c.in @@ -0,0 +1,52 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write(FILE fh, BUFFER x, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), + OMPI_FINT_2_INT(*count), + c_type, c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/free_mem_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/free_mem_ts.c.in new file mode 100644 index 00000000000..af159fac3b9 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/free_mem_ts.c.in @@ -0,0 +1,40 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" + +static const char FUNC_NAME[] = "MPI_Free_mem"; + +void ompi_free_mem_ts(CFI_cdesc_t *x, MPI_Fint *ierr) +{ + int c_ierr; + if (OMPI_CFI_IS_CONTIGUOUS(x)) { + c_ierr = PMPI_Free_mem(x->base_addr); + } else { + c_ierr = MPI_ERR_BUFFER; + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/gather_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/gather_ts.c.in new file mode 100644 index 00000000000..b7886805ada --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/gather_ts.c.in @@ -0,0 +1,105 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Gather"; + +void ompi_gather_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *root, MPI_Fint *comm, MPI_Fint *ierr) +{ + int c_root, c_ierr; + MPI_Comm c_comm; + MPI_Datatype c_senddatatype = NULL, c_sendtype = NULL; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1); + int c_sendcount = 0, c_recvcount = 0; + MPI_Datatype c_recvtype = NULL; + void *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + c_comm = PMPI_Comm_f2c(*comm); + c_root = OMPI_FINT_2_INT(*root); + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else if (MPI_PROC_NULL != c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + sendbuf = MPI_IN_PLACE; + } else { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + + c_ierr = PMPI_Gather(sendbuf, c_sendcount, + c_senddatatype, recvbuf, + c_recvcount, + c_recvtype, + c_root, + c_comm); + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/gatherv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/gatherv_ts.c.in new file mode 100644 index 00000000000..ba1c3ec96aa --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/gatherv_ts.c.in @@ -0,0 +1,110 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Gatherv"; + +void ompi_gatherv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, MPI_Fint *displs, + MPI_Fint *recvtype, MPI_Fint *root, MPI_Fint *comm, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_root = OMPI_FINT_2_INT(*root); + MPI_Datatype c_senddatatype = NULL, c_sendtype = NULL, c_recvtype = NULL; + int c_sendcount = 0; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + OMPI_ARRAY_NAME_DECL(recvcounts); + OMPI_ARRAY_NAME_DECL(displs); + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + OMPI_COND_STATEMENT(int size = ompi_comm_remote_size(c_comm)); + c_recvtype = PMPI_Type_f2c(*recvtype); + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_ARRAY_FINT_2_INT(recvcounts, size); + OMPI_ARRAY_FINT_2_INT(displs, size); + } else if (MPI_PROC_NULL != c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + OMPI_COND_STATEMENT(int size = ompi_comm_size(c_comm)); + c_recvtype = PMPI_Type_f2c(*recvtype); + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_ARRAY_FINT_2_INT(recvcounts, size); + OMPI_ARRAY_FINT_2_INT(displs, size); + } + if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + sendbuf = MPI_IN_PLACE; + } else { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Gatherv(sendbuf, c_sendcount, + c_senddatatype, recvbuf, + OMPI_ARRAY_NAME_CONVERT(recvcounts), + OMPI_ARRAY_NAME_CONVERT(displs), + c_recvtype, + c_root, + c_comm); + + /* TODO: Destroy datatypes */ + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts); + OMPI_ARRAY_FINT_2_INT_CLEANUP(displs); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/get_accumulate_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/get_accumulate_ts.c.in new file mode 100644 index 00000000000..5e847a5ddfb --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/get_accumulate_ts.c.in @@ -0,0 +1,84 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/win/win.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Get_accumulate"; + +void ompi_get_accumulate_ts(CFI_cdesc_t *x1, MPI_Fint *origin_count, + MPI_Fint *origin_datatype, CFI_cdesc_t *x2, + MPI_Fint *result_count, MPI_Fint *result_datatype, + MPI_Fint *target_rank, MPI_Aint *target_disp, + MPI_Fint *target_count, MPI_Fint *target_datatype, + MPI_Fint *op, MPI_Fint *win, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_result_datatype, c_result_type = PMPI_Type_f2c(*result_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + MPI_Op c_op = PMPI_Op_f2c(*op); + char *origin_addr = OMPI_CFI_BASE_ADDR(x1); + int c_origin_count = OMPI_INT_2_FINT(*origin_count); + char *result_addr = OMPI_CFI_BASE_ADDR(x2); + int c_result_count = OMPI_INT_2_FINT(*result_count); + + OMPI_CFI_2_C(x1, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_2_C(x2, c_result_count, c_result_type, c_result_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + c_ierr = PMPI_Get_accumulate(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_F2C_BOTTOM(result_addr), + c_result_count, + c_result_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + OMPI_FINT_2_INT(*target_count), + c_target_datatype, c_op, c_win); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + if (c_result_datatype != c_result_type) { + ompi_datatype_destroy(&c_result_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/get_address_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/get_address_ts.c.in new file mode 100644 index 00000000000..d76d0c34baa --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/get_address_ts.c.in @@ -0,0 +1,40 @@ +/* + * 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-2019 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/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Get_address"; + +void ompi_get_address_ts(CFI_cdesc_t *x, MPI_Aint *address, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Aint c_address; + + c_ierr = PMPI_Get_address(OMPI_F2C_BOTTOM(OMPI_CFI_BASE_ADDR(x)), &c_address); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *address = (MPI_Aint) c_address; + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/get_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/get_ts.c.in new file mode 100644 index 00000000000..7287fce08fb --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/get_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/win/win.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Get"; + +void ompi_get_ts(CFI_cdesc_t *x, MPI_Fint *origin_count, + MPI_Fint *origin_datatype, MPI_Fint *target_rank, + MPI_Aint *target_disp, MPI_Fint *target_count, + MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + char *origin_addr = OMPI_CFI_BASE_ADDR(x); + int c_origin_count = OMPI_INT_2_FINT(*origin_count); + + OMPI_CFI_2_C(x, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + c_ierr = PMPI_Get(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + OMPI_FINT_2_INT(*target_count), + c_target_datatype, c_win); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/iallgather_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/iallgather_ts.c.in new file mode 100644 index 00000000000..741f5480df4 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/iallgather_ts.c.in @@ -0,0 +1,77 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Iallgather"; + +void ompi_iallgather_ts(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t* x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Request c_req; + MPI_Datatype c_sendtype = NULL, c_senddatatype = NULL; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1); + int c_sendcount = 0; + MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype); + void *recvbuf = OMPI_CFI_BASE_ADDR(x2); + int c_recvcount = OMPI_FINT_2_INT(*recvcount); + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + sendbuf = MPI_IN_PLACE; + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Iallgather(sendbuf, c_sendcount, c_sendtype, + recvbuf, c_recvcount, c_recvtype, + c_comm, &c_req); + + if (c_senddatatype != c_sendtype && c_senddatatype != NULL) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_req); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/iallgatherv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/iallgatherv_ts.c.in new file mode 100644 index 00000000000..8a6967ce03e --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/iallgatherv_ts.c.in @@ -0,0 +1,103 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Iallgatherv"; + +void ompi_iallgatherv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, MPI_Fint *displs, + MPI_Fint *recvtype, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_sendcount = 0; + MPI_Datatype c_sendtype = NULL, c_senddatatype = NULL; + MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + MPI_Request c_request; + OMPI_COND_STATEMENT(int size); + OMPI_ARRAY_NAME_DECL(recvcounts); + OMPI_ARRAY_NAME_DECL(displs); + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + if (OMPI_COMM_IS_INTER(c_comm)) { + OMPI_COND_STATEMENT(size = ompi_comm_remote_size(c_comm)); + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } else { + OMPI_COND_STATEMENT(size = ompi_comm_size(c_comm)); + if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + sendbuf = MPI_IN_PLACE; + } else { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } + + OMPI_ARRAY_FINT_2_INT(recvcounts, size); + OMPI_ARRAY_FINT_2_INT(displs, size); + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + OMPI_ARRAY_FINT_2_INT(recvcounts, size); + OMPI_ARRAY_FINT_2_INT(displs, size); + + c_ierr = PMPI_Iallgatherv(sendbuf, c_sendcount, c_sendtype, + recvbuf, + OMPI_ARRAY_NAME_CONVERT(recvcounts), + OMPI_ARRAY_NAME_CONVERT(displs), + c_recvtype, + c_comm, &c_request); + + if (c_senddatatype != c_sendtype && NULL != c_senddatatype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); + + OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts); + OMPI_ARRAY_FINT_2_INT_CLEANUP(displs); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/iallreduce_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/iallreduce_ts.c.in new file mode 100644 index 00000000000..544ca204758 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/iallreduce_ts.c.in @@ -0,0 +1,67 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Iallreduce"; + +void ompi_iallreduce_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + int c_count = OMPI_FINT_2_INT(*count); + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Request c_request; + MPI_Op c_op; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Iallreduce(sendbuf, recvbuf, + c_count, + c_type, c_op, c_comm, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ialltoall_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ialltoall_ts.c.in new file mode 100644 index 00000000000..f750bdb5d20 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ialltoall_ts.c.in @@ -0,0 +1,74 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Alltoall"; + +void ompi_ialltoall_ts(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t* x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_sendtype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype); + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + int c_sendcount = 0, c_recvcount = OMPI_FINT_2_INT(*recvcount); + MPI_Request c_request; + + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + sendbuf = MPI_IN_PLACE; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Ialltoall(sendbuf, + c_sendcount, + c_sendtype, + recvbuf, + c_recvcount, + c_recvtype, c_comm, &c_request); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ialltoallv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ialltoallv_ts.c.in new file mode 100644 index 00000000000..11e425ede4c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ialltoallv_ts.c.in @@ -0,0 +1,93 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Ialltoallv"; + +void ompi_ialltoallv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, MPI_Fint *sdispls, + MPI_Fint *sendtype, CFI_cdesc_t *x2, MPI_Fint *recvcounts, + MPI_Fint *rdispls, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + MPI_Datatype c_sendtype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype); + MPI_Request c_request; + OMPI_COND_STATEMENT(int size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm)); + OMPI_ARRAY_NAME_DECL(sendcounts); + OMPI_ARRAY_NAME_DECL(sdispls); + OMPI_ARRAY_NAME_DECL(recvcounts); + OMPI_ARRAY_NAME_DECL(rdispls); + + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_ARRAY_FINT_2_INT(sendcounts, size); + OMPI_ARRAY_FINT_2_INT(sdispls, size); + } else { + sendbuf = MPI_IN_PLACE; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + OMPI_ARRAY_FINT_2_INT(recvcounts, size); + OMPI_ARRAY_FINT_2_INT(rdispls, size); + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Ialltoallv(sendbuf, + OMPI_ARRAY_NAME_CONVERT(sendcounts), + OMPI_ARRAY_NAME_CONVERT(sdispls), + c_sendtype, + recvbuf, + OMPI_ARRAY_NAME_CONVERT(recvcounts), + OMPI_ARRAY_NAME_CONVERT(rdispls), + c_recvtype, c_comm, &c_request); + + /* TODO: Destroy datatypes */ + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); + if (MPI_IN_PLACE == sendbuf) { + OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts); + OMPI_ARRAY_FINT_2_INT_CLEANUP(sdispls); + } + OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts); + OMPI_ARRAY_FINT_2_INT_CLEANUP(rdispls); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ialltoallw_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ialltoallw_ts.c.in new file mode 100644 index 00000000000..2c5c0cbe2bc --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ialltoallw_ts.c.in @@ -0,0 +1,100 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Ialltoallw"; + +void ompi_ialltoallw_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, + MPI_Fint *sdispls, MPI_Fint *sendtypes, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, + MPI_Fint *rdispls, MPI_Fint *recvtypes, + MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) +{ + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype *c_sendtypes = NULL, *c_recvtypes; + MPI_Request c_request; + int size, c_ierr; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + OMPI_ARRAY_NAME_DECL(sendcounts); + OMPI_ARRAY_NAME_DECL(sdispls); + OMPI_ARRAY_NAME_DECL(recvcounts); + OMPI_ARRAY_NAME_DECL(rdispls); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm); + + if (!OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype)); + OMPI_ARRAY_FINT_2_INT(sendcounts, size); + OMPI_ARRAY_FINT_2_INT(sdispls, size); + for (int i=0; i 0) { + c_sendtypes[size - 1] = PMPI_Type_f2c(sendtypes[size - 1]); + c_recvtypes[size - 1] = PMPI_Type_f2c(recvtypes[size - 1]); + --size; + } + + /* Ineighbor_alltoallw does not support MPI_IN_PLACE */ + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Ineighbor_alltoallw(sendbuf, + OMPI_ARRAY_NAME_CONVERT(sendcounts), + sdispls, + c_sendtypes, + recvbuf, + OMPI_ARRAY_NAME_CONVERT(recvcounts), + rdispls, + c_recvtypes, c_comm, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); + + OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts); + OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts); + free(c_sendtypes); + free(c_recvtypes); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/irecv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/irecv_ts.c.in new file mode 100644 index 00000000000..26b60593bfa --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/irecv_ts.c.in @@ -0,0 +1,52 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE void irecv(BUFFER_OUT x, COUNT count, DATATYPE datatype, + RANK source, TAG tag, COMM comm, + REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*source), + OMPI_FINT_2_INT(*tag), c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_block_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_block_ts.c.in new file mode 100644 index 00000000000..a2752e764f4 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_block_ts.c.in @@ -0,0 +1,71 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Ireduce_scatter_block"; + +void ompi_ireduce_scatter_block_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, + MPI_Fint *recvcount, MPI_Fint *datatype, + MPI_Fint *op, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Request c_request; + MPI_Op c_op; + int size; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + PMPI_Comm_size(c_comm, &size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Ireduce_scatter_block(sendbuf, recvbuf, + OMPI_FINT_2_INT(*recvcount), + c_type, c_op, c_comm, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_ts.c.in new file mode 100644 index 00000000000..628d6dd3977 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_ts.c.in @@ -0,0 +1,72 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Ireduce_scatter"; + +void ompi_ireduce_scatter_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, + MPI_Fint *recvcounts, MPI_Fint *datatype, + MPI_Fint *op, MPI_Fint *comm, MPI_Fint *request, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Request c_request; + MPI_Op c_op; + int size; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + OMPI_ARRAY_NAME_DECL(recvcounts); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + PMPI_Comm_size(c_comm, &size); + OMPI_ARRAY_FINT_2_INT(recvcounts, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Ireduce_scatter(sendbuf, recvbuf, + OMPI_ARRAY_NAME_CONVERT(recvcounts), + c_type, c_op, c_comm, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ireduce_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ireduce_ts.c.in new file mode 100644 index 00000000000..72c33de31dd --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ireduce_ts.c.in @@ -0,0 +1,70 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Ireduce"; + +void ompi_ireduce_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, + MPI_Fint *root, MPI_Fint *comm, MPI_Fint *request, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_type; + MPI_Request c_request; + MPI_Op c_op; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Ireduce(sendbuf, recvbuf, + OMPI_FINT_2_INT(*count), + c_type, c_op, + OMPI_FINT_2_INT(*root), + c_comm, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/irsend_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/irsend_ts.c.in new file mode 100644 index 00000000000..85204a24497 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/irsend_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Irsend"; + +void ompi_irsend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Irsend(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), c_comm, + &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/iscan_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/iscan_ts.c.in new file mode 100644 index 00000000000..3c19f92234d --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/iscan_ts.c.in @@ -0,0 +1,68 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Iscan"; + +void ompi_iscan_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Request c_request; + MPI_Op c_op; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Iscan(sendbuf, recvbuf, + OMPI_FINT_2_INT(*count), + c_type, c_op, + c_comm, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/iscatter_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/iscatter_ts.c.in new file mode 100644 index 00000000000..0fa57f0d367 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/iscatter_ts.c.in @@ -0,0 +1,103 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Iscatter"; + +void ompi_iscatter_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, + MPI_Fint *sendtype, CFI_cdesc_t *x2, + MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *root, MPI_Fint *comm, MPI_Fint *request, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_root = OMPI_FINT_2_INT(*root); + MPI_Datatype c_sendtype = NULL, c_recvtype = NULL, c_recvdatatype = NULL; + int c_sendcount = 0, c_recvcount = 0; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + MPI_Request c_request; + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } else if (MPI_PROC_NULL != c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + if (OMPI_IS_FORTRAN_IN_PLACE(recvbuf)) { + recvbuf = MPI_IN_PLACE; + } else { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } + + recvbuf = (char *) OMPI_F2C_IN_PLACE(recvbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + + c_ierr = PMPI_Iscatter(sendbuf,c_sendcount, c_sendtype, + recvbuf, c_recvcount, c_recvdatatype, + c_root, c_comm, &c_request); + + /* TODO: Destroy datatypes */ + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/iscatterv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/iscatterv_ts.c.in new file mode 100644 index 00000000000..80aa4e3fb9a --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/iscatterv_ts.c.in @@ -0,0 +1,114 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Iscatterv"; + +void ompi_iscatterv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, + MPI_Fint *displs, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, + MPI_Fint *recvtype, MPI_Fint *root, + MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_root = OMPI_FINT_2_INT(*root); + MPI_Datatype c_sendtype = NULL, c_recvtype = NULL, c_recvdatatype = NULL; + int c_recvcount = 0; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + MPI_Request c_request; + OMPI_ARRAY_NAME_DECL(sendcounts); + OMPI_ARRAY_NAME_DECL(displs); + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + OMPI_COND_STATEMENT(int size = ompi_comm_size(c_comm)); + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_ARRAY_FINT_2_INT(sendcounts, size); + OMPI_ARRAY_FINT_2_INT(displs, size); + } else if (MPI_PROC_NULL != c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + OMPI_COND_STATEMENT(int size = ompi_comm_size(c_comm)); + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_ARRAY_FINT_2_INT(sendcounts, size); + OMPI_ARRAY_FINT_2_INT(displs, size); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + if (OMPI_IS_FORTRAN_IN_PLACE(recvbuf)) { + recvbuf = MPI_IN_PLACE; + } else { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } + + recvbuf = (char *) OMPI_F2C_IN_PLACE(recvbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Iscatterv(sendbuf, + OMPI_ARRAY_NAME_CONVERT(sendcounts), + OMPI_ARRAY_NAME_CONVERT(displs), + c_sendtype, + recvbuf, c_recvcount, c_recvtype, + c_root, c_comm, &c_request); + + /* TODO: Free datatypes */ + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); + + OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts); + OMPI_ARRAY_FINT_2_INT_CLEANUP(displs); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/isend_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/isend_ts.c.in new file mode 100644 index 00000000000..d5ba569355f --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/isend_ts.c.in @@ -0,0 +1,52 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID isend(BUFFER x, COUNT count, DATATYPE datatype, RANK dest, + TAG tag, COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/isendrecv_replace_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/isendrecv_replace_ts.c.in new file mode 100644 index 00000000000..3843b74e993 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/isendrecv_replace_ts.c.in @@ -0,0 +1,68 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Isendrecv_replace"; + +void ompi_isendrecv_replace_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *sendtag, + MPI_Fint *source, MPI_Fint *recvtag, + MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Request c_req; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + MPI_Status c_status; + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Isendrecv_replace(OMPI_F2C_BOTTOM(buf), + OMPI_FINT_2_INT(*count), + c_datatype, + OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*sendtag), + OMPI_FINT_2_INT(*source), + OMPI_FINT_2_INT(*recvtag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/isendrecv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/isendrecv_ts.c.in new file mode 100644 index 00000000000..cef1007092e --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/isendrecv_ts.c.in @@ -0,0 +1,82 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Isendrecv"; + +void ompi_isendrecv_ts(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + MPI_Fint *dest, MPI_Fint *sendtag, CFI_cdesc_t* x2, + MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *source, MPI_Fint *recvtag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + MPI_Request c_req; + MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype); + MPI_Datatype c_recvdatatype, c_recvtype = PMPI_Type_f2c(*recvtype); + void *sendbuf = OMPI_CFI_BASE_ADDR(x1); + int c_sendcount = OMPI_FINT_2_INT(*sendcount); + void *recvbuf = OMPI_CFI_BASE_ADDR(x2); + int c_recvcount = OMPI_FINT_2_INT(*recvcount); + + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Isendrecv(OMPI_F2C_BOTTOM(sendbuf), c_sendcount, + c_senddatatype, + OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*sendtag), + OMPI_F2C_BOTTOM(recvbuf), c_recvcount, + c_recvdatatype, OMPI_FINT_2_INT(*source), + OMPI_FINT_2_INT(*recvtag), + c_comm, &c_req); + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + if (c_recvdatatype != c_recvtype) { + ompi_datatype_destroy(&c_recvdatatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/issend_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/issend_ts.c.in new file mode 100644 index 00000000000..370404ffd0d --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/issend_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Issend"; + +void ompi_issend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Issend(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am index bf6595c0d9f..5e7d574ef10 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am @@ -10,6 +10,8 @@ # Copyright (c) 2015-2020 Research Organization for Information Science # and Technology (RIST). All rights reserved. # Copyright (c) 2016 IBM Corporation. All rights reserved. +# Copyright (C) 2024 Triad National Security, LLC. All rights +# reserved. # # $COPYRIGHT$ # @@ -64,7 +66,9 @@ libforce_usempif08_internal_modules_to_be_built_la_SOURCES = \ nodist_noinst_HEADERS = mpi-f08-interfaces.h -noinst_HEADERS = mpi-f08-rename.h +noinst_HEADERS = \ + mpi-f08-rename.h \ + mpi-f08-interfaces-generated.h libforce_usempi_internal_modules_to_be_built.la: libusempif08_internal_modules.la @@ -72,6 +76,24 @@ config_h = \ $(top_builddir)/ompi/mpi/fortran/configure-fortran-output.h \ $(top_srcdir)/ompi/mpi/fortran/configure-fortran-output-bottom.h +# Generate the Fortran interfaces +if OMPI_GENERATE_BINDINGS + +include ../Makefile.prototype_files + +mpi-f08-interfaces-generated.h: $(prototype_files) + $(OMPI_V_GEN) $(PYTHON) $(top_srcdir)/ompi/mpi/bindings/bindings.py \ + --builddir $(abs_top_builddir) \ + --srcdir $(abs_top_srcdir) \ + --output $(abs_builddir)/$@ \ + fortran \ + interface \ + --prototype-files $(ready_prototype_files) + +# Delete generated file on maintainer-clean +MAINTAINERCLEANFILES = mpi-f08-interfaces-generated.h +endif + # # Automake doesn't do Fortran dependency analysis, so must list them # manually here. Bummer! @@ -83,6 +105,7 @@ mpi-f08-interfaces.lo: $(config_h) mpi-f08-interfaces.lo: mpi-f08-interfaces.F90 mpi-f08-interfaces.lo: mpi-f08-interfaces-callbacks.lo mpi-f08-interfaces.lo: mpi-f08-interfaces.h +mpi-f08-interfaces.lo: mpi-f08-interfaces-generated.h mpi-f08-interfaces-callbacks.lo: $(config_h) mpi-f08-interfaces-callbacks.lo: mpi-f08-interfaces-callbacks.F90 mpi-f08-interfaces-callbacks.lo: mpi-f08-types.lo @@ -94,6 +117,7 @@ pmpi-f08-interfaces.lo: pmpi-f08-interfaces.F90 pmpi-f08-interfaces.lo: mpi-f08-interfaces-callbacks.lo pmpi-f08-interfaces.lo: mpi-f08-interfaces.h pmpi-f08-interfaces.lo: mpi-f08-rename.h +pmpi-f08-interfaces.lo: mpi-f08-interfaces-generated.h ########################################################################### diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.F90 b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.F90 index 71cefb1f128..ad4a92223b0 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.F90 +++ b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.F90 @@ -24,6 +24,7 @@ module mpi_f08_interfaces #include "mpi-f08-interfaces.h" +#include "mpi-f08-interfaces-generated.h" ! MPI_Wtick is not a wrapper function ! diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in index c66f92d1332..530bf30b41a 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in +++ b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in @@ -19,19 +19,6 @@ ! and the name for tools ("MPI_Init_f08") and the back-end implementation ! name (e.g., "MPI_Init_f08"). -interface MPI_Bsend -subroutine MPI_Bsend_f08(buf,count,datatype,dest,tag,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Bsend_f08 -end interface MPI_Bsend - interface MPI_Bsend_init subroutine MPI_Bsend_init_f08(buf,count,datatype,dest,tag,comm,request,ierror) use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request @@ -112,20 +99,6 @@ subroutine MPI_Iprobe_f08(source,tag,comm,flag,status,ierror) end subroutine MPI_Iprobe_f08 end interface MPI_Iprobe -interface MPI_Irecv -subroutine MPI_Irecv_f08(buf,count,datatype,source,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, source, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Irecv_f08 -end interface MPI_Irecv - interface MPI_Irsend subroutine MPI_Irsend_f08(buf,count,datatype,dest,tag,comm,request,ierror) use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request @@ -140,20 +113,6 @@ subroutine MPI_Irsend_f08(buf,count,datatype,dest,tag,comm,request,ierror) end subroutine MPI_Irsend_f08 end interface MPI_Irsend -interface MPI_Isend -subroutine MPI_Isend_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Isend_f08 -end interface MPI_Isend - interface MPI_Isendrecv subroutine MPI_Isendrecv_f08(sendbuf,sendcount,sendtype,dest,sendtag,recvbuf, & recvcount,recvtype,source,recvtag,comm,request,ierror) @@ -203,12 +162,8 @@ interface MPI_Precv_init subroutine MPI_Precv_init_f08(buf,partitions,count,datatype,dest,tag,comm,request,ierror) use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request, MPI_COUNT_KIND implicit none - !DEC$ ATTRIBUTES NO_ARG_CHECK :: buf - !GCC$ ATTRIBUTES NO_ARG_CHECK :: buf - !$PRAGMA IGNORE_TKR buf - !DIR$ IGNORE_TKR buf - !IBM* IGNORE_TKR buf - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf + @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf INTEGER, INTENT(IN) :: partitions, dest, tag INTEGER(MPI_COUNT_KIND), INTENT(IN) :: count TYPE(MPI_Datatype), INTENT(IN) :: datatype @@ -222,12 +177,8 @@ interface MPI_Psend_init subroutine MPI_Psend_init_f08(buf,partitions,count,datatype,dest,tag,comm,request,ierror) use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request, MPI_COUNT_KIND implicit none - !DEC$ ATTRIBUTES NO_ARG_CHECK :: buf - !GCC$ ATTRIBUTES NO_ARG_CHECK :: buf - !$PRAGMA IGNORE_TKR buf - !DIR$ IGNORE_TKR buf - !IBM* IGNORE_TKR buf - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf + @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf INTEGER, INTENT(IN) :: partitions, dest, tag INTEGER(MPI_COUNT_KIND), INTENT(IN) :: count TYPE(MPI_Datatype), INTENT(IN) :: datatype @@ -290,20 +241,6 @@ subroutine MPI_Probe_f08(source,tag,comm,status,ierror) end subroutine MPI_Probe_f08 end interface MPI_Probe -interface MPI_Recv -subroutine MPI_Recv_f08(buf,count,datatype,source,tag,comm,status,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Status - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf - INTEGER, INTENT(IN) :: count, source, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Recv_f08 -end interface MPI_Recv - interface MPI_Recv_init subroutine MPI_Recv_init_f08(buf,count,datatype,source,tag,comm,request,ierror) use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request @@ -365,19 +302,6 @@ subroutine MPI_Rsend_init_f08(buf,count,datatype,dest,tag,comm,request,ierror) end subroutine MPI_Rsend_init_f08 end interface MPI_Rsend_init -interface MPI_Send -subroutine MPI_Send_f08(buf,count,datatype,dest,tag,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Send_f08 -end interface MPI_Send - interface MPI_Sendrecv subroutine MPI_Sendrecv_f08(sendbuf,sendcount,sendtype,dest,sendtag,recvbuf, & recvcount,recvtype,source,recvtag,comm,status,ierror) @@ -598,19 +522,6 @@ subroutine MPI_Testall_f08(count,array_of_requests,flag,array_of_statuses,ierror end subroutine MPI_Testall_f08 end interface MPI_Testall -interface MPI_Testany -subroutine MPI_Testany_f08(count,array_of_requests,index,flag,status,ierror) - use :: mpi_f08_types, only : MPI_Request, MPI_Status - implicit none - INTEGER, INTENT(IN) :: count - TYPE(MPI_Request), INTENT(INOUT) :: array_of_requests(count) - INTEGER, INTENT(OUT) :: index - LOGICAL, INTENT(OUT) :: flag - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Testany_f08 -end interface MPI_Testany - interface MPI_Testsome subroutine MPI_Testsome_f08(incount,array_of_requests,outcount, & array_of_indices,array_of_statuses,ierror) @@ -644,17 +555,6 @@ subroutine MPI_Wait_f08(request,status,ierror) end subroutine MPI_Wait_f08 end interface MPI_Wait -interface MPI_Waitall -subroutine MPI_Waitall_f08(count,array_of_requests,array_of_statuses,ierror) - use :: mpi_f08_types, only : MPI_Request, MPI_Status - implicit none - INTEGER, INTENT(IN) :: count - TYPE(MPI_Request), INTENT(INOUT) :: array_of_requests(count) - TYPE(MPI_Status) :: array_of_statuses(*) - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Waitall_f08 -end interface MPI_Waitall - interface MPI_Waitany subroutine MPI_Waitany_f08(count,array_of_requests,index,status,ierror) use :: mpi_f08_types, only : MPI_Request, MPI_Status @@ -1059,21 +959,6 @@ subroutine MPI_Unpack_external_f08(datarep,inbuf,insize,position,outbuf,outcount end subroutine MPI_Unpack_external_f08 end interface MPI_Unpack_external -interface MPI_Allgather -subroutine MPI_Allgather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Allgather_f08 -end interface MPI_Allgather - interface MPI_Iallgather subroutine MPI_Iallgather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & comm,request,ierror) @@ -1107,22 +992,6 @@ subroutine MPI_Allgather_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,r end subroutine MPI_Allgather_init_f08 end interface MPI_Allgather_init -interface MPI_Allgatherv -subroutine MPI_Allgatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, & - recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Allgatherv_f08 -end interface MPI_Allgatherv - interface MPI_Iallgatherv subroutine MPI_Iallgatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, & recvtype,comm,request,ierror) @@ -1158,21 +1027,6 @@ subroutine MPI_Allgatherv_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts end subroutine MPI_Allgatherv_init_f08 end interface MPI_Allgatherv_init -interface MPI_Allreduce -subroutine MPI_Allreduce_f08(sendbuf,recvbuf,count,datatype,op,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Allreduce_f08 -end interface MPI_Allreduce - interface MPI_Iallreduce subroutine MPI_Iallreduce_f08(sendbuf,recvbuf,count,datatype,op,comm,request,ierror) use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request @@ -1206,21 +1060,6 @@ subroutine MPI_Allreduce_init_f08(sendbuf,recvbuf,count,datatype,op,comm,info,re end subroutine MPI_Allreduce_init_f08 end interface MPI_Allreduce_init -interface MPI_Alltoall -subroutine MPI_Alltoall_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Alltoall_f08 -end interface MPI_Alltoall - interface MPI_Ialltoall subroutine MPI_Ialltoall_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & comm,request,ierror) @@ -1254,21 +1093,6 @@ subroutine MPI_Alltoall_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,re end subroutine MPI_Alltoall_init_f08 end interface MPI_Alltoall_init -interface MPI_Alltoallv -subroutine MPI_Alltoallv_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,recvcounts, & - rdispls,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Alltoallv_f08 -end interface MPI_Alltoallv - interface MPI_Ialltoallv subroutine MPI_Ialltoallv_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,recvcounts, & rdispls,recvtype,comm,request,ierror) @@ -1302,21 +1126,6 @@ subroutine MPI_Alltoallv_init_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,re end subroutine MPI_Alltoallv_init_f08 end interface MPI_Alltoallv_init -interface MPI_Alltoallw -subroutine MPI_Alltoallw_f08(sendbuf,sendcounts,sdispls,sendtypes,recvbuf,recvcounts, & - rdispls,recvtypes,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtypes(*), recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Alltoallw_f08 -end interface MPI_Alltoallw - interface MPI_Ialltoallw subroutine MPI_Ialltoallw_f08(sendbuf,sendcounts,sdispls,sendtypes,recvbuf,recvcounts, & rdispls,recvtypes,comm,request,ierror) @@ -1380,19 +1189,6 @@ subroutine MPI_Barrier_init_f08(comm,info,request,ierror) end subroutine MPI_Barrier_init_f08 end interface MPI_Barrier_init -interface MPI_Bcast -subroutine MPI_Bcast_f08(buffer,count,datatype,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buffer - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buffer - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Bcast_f08 -end interface MPI_Bcast - interface MPI_Ibcast subroutine MPI_Ibcast_f08(buffer,count,datatype,root,comm,request,ierror) use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request @@ -1600,21 +1396,6 @@ subroutine MPI_Op_free_f08(op,ierror) end subroutine MPI_Op_free_f08 end interface MPI_Op_free -interface MPI_Reduce -subroutine MPI_Reduce_f08(sendbuf,recvbuf,count,datatype,op,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Reduce_f08 -end interface MPI_Reduce - interface MPI_Ireduce subroutine MPI_Ireduce_f08(sendbuf,recvbuf,count,datatype,op,root,comm,request,ierror) use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request @@ -3304,23 +3085,6 @@ subroutine MPI_Unpublish_name_f08(service_name,info,port_name,ierror) end subroutine MPI_Unpublish_name_f08 end interface MPI_Unpublish_name -interface MPI_Accumulate -subroutine MPI_Accumulate_f08(origin_addr,origin_count,origin_datatype,target_rank, & - target_disp,target_count,target_datatype,op,win,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ origin_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Accumulate_f08 -end interface MPI_Accumulate - interface MPI_Raccumulate subroutine MPI_Raccumulate_f08(origin_addr,origin_count,origin_datatype,target_rank, & target_disp,target_count,target_datatype,op,win,request, & @@ -3515,18 +3279,6 @@ subroutine MPI_Win_create_dynamic_f08(info,comm,win,ierror) end subroutine MPI_Win_create_dynamic_f08 end interface MPI_Win_create_dynamic -interface MPI_Win_attach -subroutine MPI_Win_attach_f08(win,base,size,ierror) - use :: mpi_f08_types, only : MPI_Win, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ base - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: base - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: size - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Win_attach_f08 -end interface MPI_Win_attach - interface MPI_Win_detach subroutine MPI_Win_detach_f08(win,base,ierror) use :: mpi_f08_types, only : MPI_Win, MPI_ADDRESS_KIND @@ -4319,20 +4071,6 @@ subroutine MPI_File_sync_f08(fh,ierror) end subroutine MPI_File_sync_f08 end interface MPI_File_sync -interface MPI_File_write -subroutine MPI_File_write_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_f08 -end interface MPI_File_write - interface MPI_File_write_all subroutine MPI_File_write_all_f08(fh,buf,count,datatype,status,ierror) use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h index 41e747e975c..14b396bcbb5 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h +++ b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h @@ -49,6 +49,7 @@ #define MPI_Probe_f08 PMPI_Probe_f08 #define MPI_Recv PMPI_Recv #define MPI_Recv_f08 PMPI_Recv_f08 +#define MPI_Recv_f08_c PMPI_Recv_f08_c #define MPI_Recv_init PMPI_Recv_init #define MPI_Recv_init_f08 PMPI_Recv_init_f08 #define MPI_Request_free PMPI_Request_free @@ -61,6 +62,7 @@ #define MPI_Rsend_init_f08 PMPI_Rsend_init_f08 #define MPI_Send PMPI_Send #define MPI_Send_f08 PMPI_Send_f08 +#define MPI_Send_f08_c PMPI_Send_f08_c #define MPI_Sendrecv PMPI_Sendrecv #define MPI_Sendrecv_f08 PMPI_Sendrecv_f08 #define MPI_Sendrecv_replace PMPI_Sendrecv_replace diff --git a/ompi/mpi/fortran/use-mpi-f08/mrecv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/mrecv_ts.c.in new file mode 100644 index 00000000000..0327090f08e --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/mrecv_ts.c.in @@ -0,0 +1,68 @@ +/* + * 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) 2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015 FUJITSU LIMITED. All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Mrecv"; + +void ompi_mrecv_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *message, MPI_Fint *status, MPI_Fint *ierr) +{ + int c_ierr; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + MPI_Message c_message = PMPI_Message_f2c(*message); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + return; + } + + + /* Call the C function */ + c_ierr = PMPI_Mrecv(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, &c_message, + c_status); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) + /* message is an INOUT, and may be updated by the recv */ + *message = PMPI_Message_c2f(c_message); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_ts.c.in new file mode 100644 index 00000000000..03ca4ccb739 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_ts.c.in @@ -0,0 +1,75 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Neighbor_allgather"; + +void ompi_neighbor_allgather_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype); + void *sendbuf = OMPI_CFI_BASE_ADDR(x1); + int c_sendcount = OMPI_FINT_2_INT(*sendcount); + MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype); + void *recvbuf = OMPI_CFI_BASE_ADDR(x2); + int c_recvcount = OMPI_FINT_2_INT(*recvcount); + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Neighbor_allgather(sendbuf, + c_sendcount, + c_sendtype, + recvbuf, + c_recvcount, + c_recvtype, c_comm); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_ts.c.in new file mode 100644 index 00000000000..91f87f9a2e4 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_ts.c.in @@ -0,0 +1,85 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Neighbor_allgatherv"; + +void ompi_neighbor_allgatherv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, MPI_Fint *displs, + MPI_Fint *recvtype, MPI_Fint *comm, MPI_Fint *ierr) +{ + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + int c_sendcount = OMPI_FINT_2_INT(*sendcount); + MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype); + int size, c_ierr; + OMPI_ARRAY_NAME_DECL(recvcounts); + OMPI_ARRAY_NAME_DECL(displs); + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + + PMPI_Comm_size(c_comm, &size); + OMPI_ARRAY_FINT_2_INT(recvcounts, size); + OMPI_ARRAY_FINT_2_INT(displs, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Neighbor_allgatherv(sendbuf, + c_sendcount, + c_sendtype, + recvbuf, + OMPI_ARRAY_NAME_CONVERT(recvcounts), + OMPI_ARRAY_NAME_CONVERT(displs), + c_recvtype, c_comm); + + /* TODO: Free datatypes */ + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts); + OMPI_ARRAY_FINT_2_INT_CLEANUP(displs); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_ts.c.in new file mode 100644 index 00000000000..d90a81a72df --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_ts.c.in @@ -0,0 +1,70 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Neighbor_alltoall"; + +void ompi_neighbor_alltoall_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_sendtype, c_recvtype; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Neighbor_alltoall(sendbuf, + OMPI_FINT_2_INT(*sendcount), + c_sendtype, + recvbuf, + OMPI_FINT_2_INT(*recvcount), + c_recvtype, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_ts.c.in new file mode 100644 index 00000000000..68ee92b4206 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_ts.c.in @@ -0,0 +1,87 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Neighbor_alltoallv"; + +void ompi_neighbor_alltoallv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, MPI_Fint *sdispls, + MPI_Fint *sendtype, CFI_cdesc_t *x2, MPI_Fint *recvcounts, + MPI_Fint *rdispls, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr) +{ + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_sendtype, c_recvtype; + int size, c_ierr; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + OMPI_ARRAY_NAME_DECL(sendcounts); + OMPI_ARRAY_NAME_DECL(sdispls); + OMPI_ARRAY_NAME_DECL(recvcounts); + OMPI_ARRAY_NAME_DECL(rdispls); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + + PMPI_Comm_size(c_comm, &size); + OMPI_ARRAY_FINT_2_INT(sendcounts, size); + OMPI_ARRAY_FINT_2_INT(sdispls, size); + OMPI_ARRAY_FINT_2_INT(recvcounts, size); + OMPI_ARRAY_FINT_2_INT(rdispls, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Neighbor_alltoallv(sendbuf, + OMPI_ARRAY_NAME_CONVERT(sendcounts), + OMPI_ARRAY_NAME_CONVERT(sdispls), + c_sendtype, + recvbuf, + OMPI_ARRAY_NAME_CONVERT(recvcounts), + OMPI_ARRAY_NAME_CONVERT(rdispls), + c_recvtype, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts); + OMPI_ARRAY_FINT_2_INT_CLEANUP(sdispls); + OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts); + OMPI_ARRAY_FINT_2_INT_CLEANUP(rdispls); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_ts.c.in new file mode 100644 index 00000000000..ff36fb8b6de --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_ts.c.in @@ -0,0 +1,91 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Neighbor_alltoallw"; + +void ompi_neighbor_alltoallw_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, + MPI_Aint *sdispls, MPI_Fint *sendtypes, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, + MPI_Aint *rdispls, MPI_Fint *recvtypes, + MPI_Fint *comm, MPI_Fint *ierr) +{ + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype *c_sendtypes, *c_recvtypes; + int size, c_ierr; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + OMPI_ARRAY_NAME_DECL(sendcounts); + OMPI_ARRAY_NAME_DECL(recvcounts); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + PMPI_Comm_size(c_comm, &size); + + c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype)); + c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype)); + + OMPI_ARRAY_FINT_2_INT(sendcounts, size); + OMPI_ARRAY_FINT_2_INT(recvcounts, size); + + while (size > 0) { + c_sendtypes[size - 1] = PMPI_Type_f2c(sendtypes[size - 1]); + c_recvtypes[size - 1] = PMPI_Type_f2c(recvtypes[size - 1]); + --size; + } + + /* Alltoallw does not support MPI_IN_PLACE */ + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Neighbor_alltoallw(sendbuf, + OMPI_ARRAY_NAME_CONVERT(sendcounts), + sdispls, + c_sendtypes, + recvbuf, + OMPI_ARRAY_NAME_CONVERT(recvcounts), + rdispls, + c_recvtypes, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts); + OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts); + free(c_sendtypes); + free(c_recvtypes); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/pack_external_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/pack_external_ts.c.in new file mode 100644 index 00000000000..903510d19a3 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/pack_external_ts.c.in @@ -0,0 +1,82 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/constants.h" +#include "ompi/mpi/fortran/base/constants.h" +#include "ompi/mpi/fortran/base/fortran_base_strings.h" + +static const char FUNC_NAME[] = "MPI_Pack_external"; + +void ompi_pack_external_ts(char *datarep, CFI_cdesc_t* x1, MPI_Fint *incount, + MPI_Fint *datatype, CFI_cdesc_t* x2, + MPI_Aint *outsize, MPI_Aint *position, + MPI_Fint *ierr, int datarep_len) +{ + int ret, c_ierr; + char *c_datarep; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *inbuf = OMPI_CFI_BASE_ADDR(x1); + char *outbuf = OMPI_CFI_BASE_ADDR(x2); + int c_incount = OMPI_FINT_2_INT(*incount); + + /* Convert the fortran string */ + + if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len, + &c_datarep))) { + c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, ret, FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + + OMPI_CFI_2_C(x1, c_incount, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + return; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Pack_external(c_datarep, OMPI_F2C_BOTTOM(inbuf), + c_incount, + c_datatype, outbuf, + *outsize, + position); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + free(c_datarep); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/pack_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/pack_ts.c.in new file mode 100644 index 00000000000..14238cb871f --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/pack_ts.c.in @@ -0,0 +1,76 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Pack"; + +void ompi_pack_ts(CFI_cdesc_t* x1, MPI_Fint *incount, MPI_Fint *datatype, + CFI_cdesc_t *x2, MPI_Fint *outsize, MPI_Fint *position, + MPI_Fint *comm, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + OMPI_SINGLE_NAME_DECL(position); + void *inbuf = OMPI_CFI_BASE_ADDR(x1); + char *outbuf = OMPI_CFI_BASE_ADDR(x2); + int c_incount = OMPI_FINT_2_INT(*incount); + int c_outsize = OMPI_FINT_2_INT(*outsize); + + OMPI_SINGLE_FINT_2_INT(position); + + OMPI_CFI_2_C(x1, c_incount, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_ierr = PMPI_Pack(OMPI_F2C_BOTTOM(inbuf), c_incount, + c_datatype, outbuf, + c_outsize, + OMPI_SINGLE_NAME_CONVERT(position), + c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_SINGLE_INT_2_FINT(position); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/profile/Makefile.am deleted file mode 100644 index 13a6148ade7..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/Makefile.am +++ /dev/null @@ -1,477 +0,0 @@ - -# -*- makefile.am -*- -# -# Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana -# University Research and Technology -# Corporation. All rights reserved. -# Copyright (c) 2004-2013 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) 2009-2021 Cisco Systems, Inc. All rights reserved. -# Copyright (c) 2011 Sandia National Laboratories. All rights reserved. -# Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. -# Copyright (c) 2012-2013 Inria. All rights reserved. -# Copyright (c) 2013 Los Alamos National Security, LLC. All rights -# reserved. -# Copyright (c) 2015-2021 Research Organization for Information Science -# and Technology (RIST). All rights reserved. -# Copyright (c) 2022 Triad National Security, LLC. All rights -# reserved. -# $COPYRIGHT$ -# -# Additional copyrights may follow -# -# $HEADER$ -# - -include $(top_srcdir)/Makefile.ompi-rules - -# Note that Automake's Fortran-buidling rules uses CPPFLAGS and -# AM_CPPFLAGS. This can cause weirdness (e.g., -# https://github.com/open-mpi/ompi/issues/7253). Let's just zero -# those out and rely on AM_FCFLAGS. -CPPFLAGS = -AM_CPPFLAGS = - -# This Makefile is only relevant if we're building the "use mpi_f08" -# MPI bindings. -if OMPI_BUILD_FORTRAN_USEMPIF08_BINDINGS - -AM_FCFLAGS = -I$(top_srcdir)/ompi/mpi/fortran/use-mpi-f08/mod \ - -I$(top_builddir)/ompi/include \ - -I$(top_srcdir)/ompi/include \ - $(OMPI_FC_MODULE_FLAG)$(top_builddir)/ompi/mpi/fortran/use-mpi \ - $(OMPI_FC_MODULE_FLAG)$(top_builddir)/ompi/$(OMPI_FORTRAN_USEMPI_DIR) \ - $(OMPI_FC_MODULE_FLAG)../mod \ - $(OMPI_FC_MODULE_FLAG)../bindings \ - -I$(top_srcdir) -I$(top_builddir) $(FCFLAGS_f90) \ - -DOMPI_BUILD_MPI_PROFILING=1 - -CLEANFILES += *.i90 - -noinst_LTLIBRARIES = libmpi_usempif08_pmpi.la - -pmpi_api_files = \ - pabort_f08.F90 \ - paccumulate_f08.F90 \ - padd_error_class_f08.F90 \ - padd_error_code_f08.F90 \ - padd_error_string_f08.F90 \ - paint_add_f08.F90 \ - paint_diff_f08.F90 \ - pallgather_f08.F90 \ - pallgather_init_f08.F90 \ - pallgatherv_f08.F90 \ - pallgatherv_init_f08.F90 \ - palloc_mem_f08.F90 \ - pallreduce_f08.F90 \ - palltoall_f08.F90 \ - palltoall_init_f08.F90 \ - palltoallv_f08.F90 \ - palltoallv_init_f08.F90 \ - palltoallw_f08.F90 \ - palltoallw_init_f08.F90 \ - pbarrier_f08.F90 \ - pbarrier_init_f08.F90 \ - pbcast_f08.F90 \ - pbcast_init_f08.F90 \ - pbsend_f08.F90 \ - pbsend_init_f08.F90 \ - pbuffer_attach_f08.F90 \ - pbuffer_detach_f08.F90 \ - pcancel_f08.F90 \ - pcart_coords_f08.F90 \ - pcart_create_f08.F90 \ - pcartdim_get_f08.F90 \ - pcart_get_f08.F90 \ - pcart_map_f08.F90 \ - pcart_rank_f08.F90 \ - pcart_shift_f08.F90 \ - pcart_sub_f08.F90 \ - pclose_port_f08.F90 \ - pcomm_accept_f08.F90 \ - pcomm_call_errhandler_f08.F90 \ - pcomm_compare_f08.F90 \ - pcomm_connect_f08.F90 \ - pcomm_create_from_group_f08.F90 \ - pcomm_create_errhandler_f08.F90 \ - pcomm_create_f08.F90 \ - pcomm_create_group_f08.F90 \ - pcomm_create_keyval_f08.F90 \ - pcomm_delete_attr_f08.F90 \ - pcomm_disconnect_f08.F90 \ - pcomm_dup_f08.F90 \ - pcomm_dup_with_info_f08.F90 \ - pcomm_idup_f08.F90 \ - pcomm_idup_with_info_f08.F90 \ - pcomm_free_f08.F90 \ - pcomm_free_keyval_f08.F90 \ - pcomm_get_attr_f08.F90 \ - pcomm_get_errhandler_f08.F90 \ - pcomm_get_info_f08.F90 \ - pcomm_get_name_f08.F90 \ - pcomm_get_parent_f08.F90 \ - pcomm_group_f08.F90 \ - pcomm_join_f08.F90 \ - pcomm_rank_f08.F90 \ - pcomm_remote_group_f08.F90 \ - pcomm_remote_size_f08.F90 \ - pcomm_set_attr_f08.F90 \ - pcomm_set_errhandler_f08.F90 \ - pcomm_set_info_f08.F90 \ - pcomm_set_name_f08.F90 \ - pcomm_size_f08.F90 \ - pcomm_spawn_f08.F90 \ - pcomm_spawn_multiple_f08.F90 \ - pcomm_split_f08.F90 \ - pcomm_split_type_f08.F90 \ - pcomm_test_inter_f08.F90 \ - pcompare_and_swap_f08.F90 \ - pdims_create_f08.F90 \ - pdist_graph_create_adjacent_f08.F90 \ - pdist_graph_create_f08.F90 \ - pdist_graph_neighbors_count_f08.F90 \ - pdist_graph_neighbors_f08.F90 \ - perrhandler_free_f08.F90 \ - perror_class_f08.F90 \ - perror_string_f08.F90 \ - pexscan_f08.F90 \ - pexscan_init_f08.F90 \ - pf_sync_reg_f08.F90 \ - pfetch_and_op_f08.F90 \ - pfile_call_errhandler_f08.F90 \ - pfile_close_f08.F90 \ - pfile_create_errhandler_f08.F90 \ - pfile_delete_f08.F90 \ - pfile_get_amode_f08.F90 \ - pfile_get_atomicity_f08.F90 \ - pfile_get_byte_offset_f08.F90 \ - pfile_get_errhandler_f08.F90 \ - pfile_get_group_f08.F90 \ - pfile_get_info_f08.F90 \ - pfile_get_position_f08.F90 \ - pfile_get_position_shared_f08.F90 \ - pfile_get_size_f08.F90 \ - pfile_get_type_extent_f08.F90 \ - pfile_get_view_f08.F90 \ - pfile_iread_at_f08.F90 \ - pfile_iread_f08.F90 \ - pfile_iread_at_all_f08.F90 \ - pfile_iread_all_f08.F90 \ - pfile_iread_shared_f08.F90 \ - pfile_iwrite_at_f08.F90 \ - pfile_iwrite_f08.F90 \ - pfile_iwrite_at_all_f08.F90 \ - pfile_iwrite_all_f08.F90 \ - pfile_iwrite_shared_f08.F90 \ - pfile_open_f08.F90 \ - pfile_preallocate_f08.F90 \ - pfile_read_all_begin_f08.F90 \ - pfile_read_all_end_f08.F90 \ - pfile_read_all_f08.F90 \ - pfile_read_at_all_begin_f08.F90 \ - pfile_read_at_all_end_f08.F90 \ - pfile_read_at_all_f08.F90 \ - pfile_read_at_f08.F90 \ - pfile_read_f08.F90 \ - pfile_read_ordered_begin_f08.F90 \ - pfile_read_ordered_end_f08.F90 \ - pfile_read_ordered_f08.F90 \ - pfile_read_shared_f08.F90 \ - pfile_seek_f08.F90 \ - pfile_seek_shared_f08.F90 \ - pfile_set_atomicity_f08.F90 \ - pfile_set_errhandler_f08.F90 \ - pfile_set_info_f08.F90 \ - pfile_set_size_f08.F90 \ - pfile_set_view_f08.F90 \ - pfile_sync_f08.F90 \ - pfile_write_all_begin_f08.F90 \ - pfile_write_all_end_f08.F90 \ - pfile_write_all_f08.F90 \ - pfile_write_at_all_begin_f08.F90 \ - pfile_write_at_all_end_f08.F90 \ - pfile_write_at_all_f08.F90 \ - pfile_write_at_f08.F90 \ - pfile_write_f08.F90 \ - pfile_write_ordered_begin_f08.F90 \ - pfile_write_ordered_end_f08.F90 \ - pfile_write_ordered_f08.F90 \ - pfile_write_shared_f08.F90 \ - pfinalized_f08.F90 \ - pfinalize_f08.F90 \ - pfree_mem_f08.F90 \ - pgather_f08.F90 \ - pgather_init_f08.F90 \ - pgatherv_f08.F90 \ - pgatherv_init_f08.F90 \ - pget_accumulate_f08.F90 \ - pget_address_f08.F90 \ - pget_count_f08.F90 \ - pget_elements_f08.F90 \ - pget_elements_x_f08.F90 \ - pget_f08.F90 \ - pget_library_version_f08.F90 \ - pget_processor_name_f08.F90 \ - pget_version_f08.F90 \ - pgraph_create_f08.F90 \ - pgraphdims_get_f08.F90 \ - pgraph_get_f08.F90 \ - pgraph_map_f08.F90 \ - pgraph_neighbors_count_f08.F90 \ - pgraph_neighbors_f08.F90 \ - pgrequest_complete_f08.F90 \ - pgrequest_start_f08.F90 \ - pgroup_compare_f08.F90 \ - pgroup_difference_f08.F90 \ - pgroup_excl_f08.F90 \ - pgroup_free_f08.F90 \ - pgroup_incl_f08.F90 \ - pgroup_intersection_f08.F90 \ - pgroup_range_excl_f08.F90 \ - pgroup_range_incl_f08.F90 \ - pgroup_rank_f08.F90 \ - pgroup_size_f08.F90 \ - pgroup_translate_ranks_f08.F90 \ - pgroup_union_f08.F90 \ - piallgather_f08.F90 \ - piallgatherv_f08.F90 \ - piallreduce_f08.F90 \ - pialltoall_f08.F90 \ - pialltoallv_f08.F90 \ - pialltoallw_f08.F90 \ - pibarrier_f08.F90 \ - pibcast_f08.F90 \ - pibsend_f08.F90 \ - pigather_f08.F90 \ - pigatherv_f08.F90 \ - piexscan_f08.F90 \ - pimprobe_f08.F90 \ - pimrecv_f08.F90 \ - pineighbor_allgather_f08.F90 \ - pineighbor_allgatherv_f08.F90 \ - pineighbor_alltoall_f08.F90 \ - pineighbor_alltoallv_f08.F90 \ - pineighbor_alltoallw_f08.F90 \ - pinfo_create_f08.F90 \ - pinfo_create_env_f08.F90 \ - pinfo_delete_f08.F90 \ - pinfo_dup_f08.F90 \ - pinfo_free_f08.F90 \ - pinfo_get_f08.F90 \ - pinfo_get_nkeys_f08.F90 \ - pinfo_get_nthkey_f08.F90 \ - pinfo_get_string_f08.F90 \ - pinfo_get_valuelen_f08.F90 \ - pinfo_set_f08.F90 \ - pinit_f08.F90 \ - pinitialized_f08.F90 \ - pinit_thread_f08.F90 \ - pintercomm_create_f08.F90 \ - pintercomm_create_from_groups_f08.F90 \ - pintercomm_merge_f08.F90 \ - piprobe_f08.F90 \ - pirecv_f08.F90 \ - pireduce_f08.F90 \ - pireduce_scatter_f08.F90 \ - pireduce_scatter_block_f08.F90 \ - pirsend_f08.F90 \ - piscan_f08.F90 \ - piscatter_f08.F90 \ - piscatterv_f08.F90 \ - pisend_f08.F90 \ - pisendrecv_f08.F90 \ - pisendrecv_replace_f08.F90 \ - pissend_f08.F90 \ - pis_thread_main_f08.F90 \ - plookup_name_f08.F90 \ - pmprobe_f08.F90 \ - pmrecv_f08.F90 \ - pneighbor_allgather_f08.F90 \ - pneighbor_allgather_init_f08.F90 \ - pneighbor_allgatherv_f08.F90 \ - pneighbor_allgatherv_init_f08.F90 \ - pneighbor_alltoall_f08.F90 \ - pneighbor_alltoall_init_f08.F90 \ - pneighbor_alltoallv_f08.F90 \ - pneighbor_alltoallv_init_f08.F90 \ - pneighbor_alltoallw_f08.F90 \ - pneighbor_alltoallw_init_f08.F90 \ - pop_commutative_f08.F90 \ - pop_create_f08.F90 \ - popen_port_f08.F90 \ - pop_free_f08.F90 \ - ppack_external_f08.F90 \ - ppack_external_size_f08.F90 \ - ppack_f08.F90 \ - ppack_size_f08.F90 \ - pparrived_f08.F90 \ - ppcontrol_f08.F90 \ - ppready_f08.F90 \ - ppready_list_f08.F90 \ - ppready_range_f08.F90 \ - pprobe_f08.F90 \ - ppsend_init_f08.F90 \ - ppublish_name_f08.F90 \ - pput_f08.F90 \ - pquery_thread_f08.F90 \ - praccumulate_f08.F90 \ - precv_f08.F90 \ - precv_init_f08.F90 \ - preduce_f08.F90 \ - preduce_init_f08.F90 \ - preduce_local_f08.F90 \ - preduce_scatter_f08.F90 \ - preduce_scatter_init_f08.F90 \ - preduce_scatter_block_f08.F90 \ - preduce_scatter_block_init_f08.F90 \ - pregister_datarep_f08.F90 \ - prequest_free_f08.F90 \ - prequest_get_status_f08.F90 \ - prget_f08.F90 \ - prget_accumulate_f08.F90 \ - prput_f08.F90 \ - prsend_f08.F90 \ - prsend_init_f08.F90 \ - pscan_f08.F90 \ - pscan_init_f08.F90 \ - pscatter_f08.F90 \ - pscatter_init_f08.F90 \ - pscatterv_f08.F90 \ - pscatterv_init_f08.F90 \ - psend_f08.F90 \ - psend_init_f08.F90 \ - psendrecv_f08.F90 \ - psendrecv_replace_f08.F90 \ - psession_create_errhandler_f08.F90\ - psession_get_errhandler_f08.F90\ - psession_get_info_f08.F90 \ - psession_get_nth_pset_f08.F90 \ - psession_get_num_psets_f08.F90 \ - psession_get_pset_info_f08.F90 \ - psession_init_f08.F90 \ - psession_finalize_f08.F90 \ - psession_set_errhandler_f08.F90\ - pssend_f08.F90 \ - pssend_init_f08.F90 \ - pstartall_f08.F90 \ - pstart_f08.F90 \ - pstatus_f082f_f08.F90 \ - pstatus_f2f08_f08.F90 \ - pstatus_set_cancelled_f08.F90 \ - pstatus_set_elements_f08.F90 \ - pstatus_set_elements_x_f08.F90 \ - ptestall_f08.F90 \ - ptestany_f08.F90 \ - ptest_cancelled_f08.F90 \ - ptest_f08.F90 \ - ptestsome_f08.F90 \ - ptopo_test_f08.F90 \ - ptype_commit_f08.F90 \ - ptype_contiguous_f08.F90 \ - ptype_create_darray_f08.F90 \ - ptype_create_f90_complex_f08.F90 \ - ptype_create_f90_integer_f08.F90 \ - ptype_create_f90_real_f08.F90 \ - ptype_create_hindexed_f08.F90 \ - ptype_create_hvector_f08.F90 \ - ptype_create_indexed_block_f08.F90 \ - ptype_create_hindexed_block_f08.F90 \ - ptype_create_keyval_f08.F90 \ - ptype_create_resized_f08.F90 \ - ptype_create_struct_f08.F90 \ - ptype_create_subarray_f08.F90 \ - ptype_delete_attr_f08.F90 \ - ptype_dup_f08.F90 \ - ptype_free_f08.F90 \ - ptype_free_keyval_f08.F90 \ - ptype_get_attr_f08.F90 \ - ptype_get_contents_f08.F90 \ - ptype_get_envelope_f08.F90 \ - ptype_get_extent_f08.F90 \ - ptype_get_extent_x_f08.F90 \ - ptype_get_name_f08.F90 \ - ptype_get_true_extent_f08.F90 \ - ptype_get_true_extent_x_f08.F90 \ - ptype_indexed_f08.F90 \ - ptype_match_size_f08.F90 \ - ptype_set_attr_f08.F90 \ - ptype_set_name_f08.F90 \ - ptype_size_f08.F90 \ - ptype_size_x_f08.F90 \ - ptype_vector_f08.F90 \ - punpack_external_f08.F90 \ - punpack_f08.F90 \ - punpublish_name_f08.F90 \ - pwaitall_f08.F90 \ - pwaitany_f08.F90 \ - pwait_f08.F90 \ - pwaitsome_f08.F90 \ - pwin_allocate_f08.F90 \ - pwin_allocate_shared_f08.F90 \ - pwin_attach_f08.F90 \ - pwin_call_errhandler_f08.F90 \ - pwin_complete_f08.F90 \ - pwin_create_dynamic_f08.F90 \ - pwin_create_errhandler_f08.F90 \ - pwin_create_f08.F90 \ - pwin_create_keyval_f08.F90 \ - pwin_delete_attr_f08.F90 \ - pwin_detach_f08.F90 \ - pwin_fence_f08.F90 \ - pwin_flush_f08.F90 \ - pwin_flush_all_f08.F90 \ - pwin_flush_local_f08.F90 \ - pwin_flush_local_all_f08.F90 \ - pwin_free_f08.F90 \ - pwin_free_keyval_f08.F90 \ - pwin_get_attr_f08.F90 \ - pwin_get_errhandler_f08.F90 \ - pwin_get_group_f08.F90 \ - pwin_get_info_f08.F90 \ - pwin_get_name_f08.F90 \ - pwin_lock_f08.F90 \ - pwin_lock_all_f08.F90 \ - pwin_post_f08.F90 \ - pwin_set_attr_f08.F90 \ - pwin_set_errhandler_f08.F90 \ - pwin_set_info_f08.F90 \ - pwin_set_name_f08.F90 \ - pwin_shared_query_f08.F90 \ - pwin_start_f08.F90 \ - pwin_sync_f08.F90 \ - pwin_test_f08.F90 \ - pwin_unlock_f08.F90 \ - pwin_unlock_all_f08.F90 \ - pwin_wait_f08.F90 - -# -# Automake doesn't do Fortran dependency analysis, so must list them -# manually here. Bummer! -# - -pmpi_api_lo_files = $(pmpi_api_files:.F90=.lo) - -$(pmpi_api_lo_files): ../bindings/libforce_usempif08_internal_bindings_to_be_built.la - -nodist_libmpi_usempif08_pmpi_la_SOURCES = \ - $(pmpi_api_files) - -# -# Sym link in the sources from the real MPI directory -# -$(nodist_libmpi_usempif08_pmpi_la_SOURCES): - $(OMPI_V_LN_S) if test ! -r $@ ; then \ - pname=`echo $@ | cut -b '2-'` ; \ - $(LN_S) $(top_srcdir)/ompi/mpi/fortran/use-mpi-f08/$$pname $@ ; \ - fi - -# These files were created by targets above - -MAINTAINERCLEANFILES = $(nodist_libmpi_usempif08_pmpi_la_SOURCES) - -endif diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/pcomm_create_from_group_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/pcomm_create_from_group_f08.F90 deleted file mode 100644 index 84098a44dc2..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/pcomm_create_from_group_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2019 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -subroutine PMPI_Comm_create_from_group_f08(group, stringtag, info, errhandler, newcomm, ierror) - use :: mpi_f08_types, only : MPI_Session, MPI_Group, MPI_Errhandler, MPI_Info, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_comm_create_from_group_f - implicit none - TYPE(MPI_Group), INTENT(IN) :: group - CHARACTER(LEN=*), INTENT(IN) :: stringtag - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Errhandler), INTENT(IN) :: errhandler - TYPE(MPI_Comm), INTENT(OUT) :: newcomm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_comm_create_from_group_f(group%MPI_VAL, stringtag, info%MPI_VAL, errhandler%MPI_VAL, & - newcomm%MPI_VAL, c_ierror, len(stringtag)) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Comm_create_from_group_f08 - diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/pgroup_from_session_pset_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/pgroup_from_session_pset_f08.F90 deleted file mode 100644 index a719b361302..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/pgroup_from_session_pset_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2019-2021 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" -#include "mpi-f08-rename.h" - -subroutine PMPI_Group_from_session_pset_f08(session, pset_name, newgroup, ierror) - use :: mpi_f08_types, only : MPI_Session, MPI_Group - use :: ompi_mpifh_bindings, only : ompi_group_from_session_pset_f - implicit none - TYPE(MPI_Session), INTENT(IN) :: session - CHARACTER(LEN=*), INTENT(IN) :: pset_name - TYPE(MPI_Group), INTENT(OUT) :: newgroup - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_group_from_session_pset_f(session%MPI_VAL, pset_name, newgroup%MPI_VAL, c_ierror, len(pset_name)) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Group_from_session_pset_f08 - diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/pintercomm_create_from_groups_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/pintercomm_create_from_groups_f08.F90 deleted file mode 100644 index 668188d1adb..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/pintercomm_create_from_groups_f08.F90 +++ /dev/null @@ -1,35 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2019 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -subroutine PMPI_Intercomm_create_from_groups_f08(local_group, local_leader, remote_group, & - remote_leader, stringtag, info, errhandler, & - newintercomm, ierror) - use :: mpi_f08_types, only : MPI_Comm, MPI_Group, MPI_Errhandler, MPI_Info - use :: ompi_mpifh_bindings, only : ompi_intercomm_create_from_groups_f - implicit none - TYPE(MPI_Group), INTENT(IN) :: local_group, remote_group - INTEGER, INTENT(IN):: local_leader, remote_leader - CHARACTER(LEN=*), INTENT(IN) :: stringtag - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Errhandler), INTENT(IN) :: errhandler - TYPE(MPI_Comm), INTENT(OUT) :: newintercomm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_intercomm_create_from_groups_f(local_group%MPI_VAL, local_leader, & - remote_group%MPI_VAL, & - remote_leader, stringtag, info%MPI_VAL, & - errhandler%MPI_VAL, & - newintercomm%MPI_VAL, c_ierror, len(stringtag)) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Intercomm_create_from_groups_f08 - diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/psession_finalize_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/psession_finalize_f08.F90 deleted file mode 100644 index 01316dd79ca..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/psession_finalize_f08.F90 +++ /dev/null @@ -1,24 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2019 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -subroutine PMPI_Session_finalize_f08(session,ierror) - use :: mpi_f08_types, only : MPI_Session - use :: ompi_mpifh_bindings, only : ompi_session_finalize_f - implicit none - TYPE(MPI_Session), INTENT(OUT) :: session - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_session_finalize_f(session%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Session_finalize_f08 - diff --git a/ompi/mpi/fortran/use-mpi-f08/put_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/put_ts.c.in new file mode 100644 index 00000000000..81e621498ee --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/put_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/win/win.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Put"; + +void ompi_put_ts(CFI_cdesc_t *x, MPI_Fint *origin_count, + MPI_Fint *origin_datatype, MPI_Fint *target_rank, + MPI_Aint *target_disp, MPI_Fint *target_count, + MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + char *origin_addr = OMPI_CFI_BASE_ADDR(x); + int c_origin_count = OMPI_INT_2_FINT(*origin_count); + + OMPI_CFI_2_C(x, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + c_ierr = PMPI_Put(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + OMPI_FINT_2_INT(*target_count), + c_target_datatype, c_win); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/raccumulate_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/raccumulate_ts.c.in new file mode 100644 index 00000000000..642f743d6b1 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/raccumulate_ts.c.in @@ -0,0 +1,73 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014-2016 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/win/win.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Raccumulate"; + +void ompi_raccumulate_ts(CFI_cdesc_t *x, MPI_Fint *origin_count, + MPI_Fint *origin_datatype, MPI_Fint *target_rank, + MPI_Aint *target_disp, MPI_Fint *target_count, + MPI_Fint *target_datatype, MPI_Fint *op, MPI_Fint *win, + MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + MPI_Op c_op = PMPI_Op_f2c(*op); + MPI_Request c_req; + char *origin_addr = OMPI_CFI_BASE_ADDR(x); + int c_origin_count = OMPI_INT_2_FINT(*origin_count); + + OMPI_CFI_2_C(x, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + c_ierr = PMPI_Raccumulate(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + OMPI_FINT_2_INT(*target_count), + c_target_datatype, c_op, c_win, + &c_req); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/recv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/recv_f08.F90 deleted file mode 100644 index 034fe0fdc19..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/recv_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- 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 "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Recv_f08(buf,count,datatype,source,tag,comm,status,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_recv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE :: buf - INTEGER, INTENT(IN) :: count, source, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_recv_f(buf,count,datatype%MPI_VAL,source,tag,comm%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Recv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/recv_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/recv_init_ts.c.in new file mode 100644 index 00000000000..a371a9bf518 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/recv_init_ts.c.in @@ -0,0 +1,62 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Recv_init"; + +void ompi_recv_init_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Recv_init(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*source), + OMPI_INT_2_FINT(*tag), c_comm, + &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/recv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/recv_ts.c.in new file mode 100644 index 00000000000..9877398931b --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/recv_ts.c.in @@ -0,0 +1,64 @@ +/* + * 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) 2012 Oracle and/or its affiliates. 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/mpif-h/status-conversion.h" +#include "ompi/mpi/fortran/base/constants.h" +*/ + +PROTOTYPE VOID recv(BUFFER_OUT x, COUNT count, DATATYPE datatype, + RANK source, TAG tag, COMM comm, STATUS_OUT status) +{ + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + int c_ierr; + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + /* Call the C function */ + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*source), + OMPI_FINT_2_INT(*tag), c_comm, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/reduce_f08.F90 deleted file mode 100644 index 1f9baea4005..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/reduce_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- 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 "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Reduce_f08(sendbuf,recvbuf,count,datatype,op,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_reduce_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_reduce_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,root,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Reduce_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_local_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/reduce_local_ts.c.in new file mode 100644 index 00000000000..fac005fe1f6 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/reduce_local_ts.c.in @@ -0,0 +1,62 @@ +/* + * 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) 2009-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Reduce_local"; + +void ompi_reduce_local_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_type; + MPI_Op c_op; + char *inbuf = OMPI_CFI_BASE_ADDR(x1), *inoutbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME) + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + inbuf = (char *) OMPI_F2C_BOTTOM(inbuf); + inoutbuf = (char *) OMPI_F2C_BOTTOM(inoutbuf); + + c_ierr = PMPI_Reduce_local(inbuf, inoutbuf, + OMPI_FINT_2_INT(*count), + c_type, c_op); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_ts.c.in new file mode 100644 index 00000000000..fab1e7b6a2c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_ts.c.in @@ -0,0 +1,67 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Reduce_scatter_block"; + +void ompi_reduce_scatter_block_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, + MPI_Fint *recvcount, MPI_Fint *datatype, + MPI_Fint *op, MPI_Fint *comm, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + int size; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + PMPI_Comm_size(c_comm, &size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Reduce_scatter_block(sendbuf, recvbuf, + OMPI_FINT_2_INT(*recvcount), + c_type, c_op, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_ts.c.in new file mode 100644 index 00000000000..35a38d0c61a --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_ts.c.in @@ -0,0 +1,70 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Reduce_scatter"; + +void ompi_reduce_scatter_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, + MPI_Fint *recvcounts, MPI_Fint *datatype, + MPI_Fint *op, MPI_Fint *comm, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + int size; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + OMPI_ARRAY_NAME_DECL(recvcounts); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + PMPI_Comm_size(c_comm, &size); + OMPI_ARRAY_FINT_2_INT(recvcounts, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Reduce_scatter(sendbuf, recvbuf, + OMPI_ARRAY_NAME_CONVERT(recvcounts), + c_type, c_op, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/reduce_ts.c.in new file mode 100644 index 00000000000..f38ab2b970f --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/reduce_ts.c.in @@ -0,0 +1,58 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID reduce(BUFFER x1, BUFFER_OUT x2, COUNT count, + DATATYPE datatype, OP op, + RANK root, COMM comm) +{ + int c_ierr; + MPI_Datatype c_type; + MPI_Op c_op; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + OMPI_FINT_2_INT(*count), + c_type, c_op, + OMPI_FINT_2_INT(*root), + c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/rget_accumulate_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/rget_accumulate_ts.c.in new file mode 100644 index 00000000000..c75cd935a48 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/rget_accumulate_ts.c.in @@ -0,0 +1,91 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014-2016 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015 FUJITSU LIMITED. All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/win/win.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Rget_accumulate"; + +void ompi_rget_accumulate_ts(CFI_cdesc_t *x1, MPI_Fint *origin_count, + MPI_Fint *origin_datatype, CFI_cdesc_t *x2, + MPI_Fint *result_count, MPI_Fint *result_datatype, + MPI_Fint *target_rank, MPI_Aint *target_disp, + MPI_Fint *target_count, MPI_Fint *target_datatype, + MPI_Fint *op, MPI_Fint *win, MPI_Fint *request, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_result_datatype, c_result_type = PMPI_Type_f2c(*result_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + MPI_Op c_op = PMPI_Op_f2c(*op); + char *origin_addr = OMPI_CFI_BASE_ADDR(x1); + int c_origin_count = OMPI_INT_2_FINT(*origin_count); + char *result_addr = OMPI_CFI_BASE_ADDR(x2); + int c_result_count = OMPI_INT_2_FINT(*result_count); + MPI_Request c_req; + + OMPI_CFI_2_C(x1, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_2_C(x2, c_result_count, c_result_type, c_result_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME); + return; + } + c_ierr = PMPI_Rget_accumulate(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_F2C_BOTTOM(result_addr), + c_result_count, + c_result_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + OMPI_FINT_2_INT(*target_count), + c_target_datatype, c_op, c_win, &c_req); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + if (c_result_datatype != c_result_type) { + ompi_datatype_destroy(&c_result_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/rget_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/rget_ts.c.in new file mode 100644 index 00000000000..371bef9a4eb --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/rget_ts.c.in @@ -0,0 +1,69 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014-2016 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/win/win.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Rget"; + +void ompi_rget_ts(CFI_cdesc_t *x, MPI_Fint *origin_count, + MPI_Fint *origin_datatype, MPI_Fint *target_rank, + MPI_Aint *target_disp, MPI_Fint *target_count, + MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *request, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + char *origin_addr = OMPI_CFI_BASE_ADDR(x); + int c_origin_count = OMPI_INT_2_FINT(*origin_count); + MPI_Request c_req; + + OMPI_CFI_2_C(x, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME); + return; + } + c_ierr = PMPI_Rget(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + OMPI_FINT_2_INT(*target_count), + c_target_datatype, c_win, &c_req); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/rput_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/rput_ts.c.in new file mode 100644 index 00000000000..305069cf084 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/rput_ts.c.in @@ -0,0 +1,69 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014-2016 Los Alamos National Security, LLC. 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/win/win.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Rput"; + +void ompi_rput_ts(CFI_cdesc_t *x, MPI_Fint *origin_count, + MPI_Fint *origin_datatype, MPI_Fint *target_rank, + MPI_Aint *target_disp, MPI_Fint *target_count, + MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *request, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + char *origin_addr = OMPI_CFI_BASE_ADDR(x); + int c_origin_count = OMPI_INT_2_FINT(*origin_count); + MPI_Request c_req; + + OMPI_CFI_2_C(x, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME); + return; + } + c_ierr = PMPI_Rput(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + OMPI_FINT_2_INT(*target_count), + c_target_datatype, c_win, &c_req); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/rsend_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/rsend_init_ts.c.in new file mode 100644 index 00000000000..4bf630bb9d6 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/rsend_init_ts.c.in @@ -0,0 +1,63 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Rsend_init"; + +void ompi_rsend_init_ts(CFI_cdesc_t* x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *dest, + MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Rsend_init(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/rsend_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/rsend_ts.c.in new file mode 100644 index 00000000000..173834a3e81 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/rsend_ts.c.in @@ -0,0 +1,55 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Rsend"; + +void ompi_rsend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Rsend(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/scan_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/scan_ts.c.in new file mode 100644 index 00000000000..92835316fce --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/scan_ts.c.in @@ -0,0 +1,66 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Scan"; + +void ompi_scan_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Scan(sendbuf, recvbuf, + OMPI_FINT_2_INT(*count), + c_type, c_op, + c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/scatter_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/scatter_ts.c.in new file mode 100644 index 00000000000..edbffd45405 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/scatter_ts.c.in @@ -0,0 +1,99 @@ +/* + * 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-2013 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Scatter"; + +void ompi_scatter_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, + MPI_Fint *sendtype, CFI_cdesc_t *x2, + MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *root, MPI_Fint *comm, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_root = OMPI_FINT_2_INT(*root); + MPI_Datatype c_sendtype = NULL, c_recvtype = NULL, c_recvdatatype = NULL; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + int c_sendcount = 0, c_recvcount = 0; + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else if (MPI_PROC_NULL != c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + if (OMPI_IS_FORTRAN_IN_PLACE(recvbuf)) { + recvbuf = MPI_IN_PLACE; + } else { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = PMPI_Scatter(sendbuf,c_sendcount, c_sendtype, + recvbuf, c_recvcount, c_recvdatatype, + c_root, c_comm); + + if (c_recvdatatype != c_recvtype) { + ompi_datatype_destroy(&c_recvdatatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/scatterv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/scatterv_ts.c.in new file mode 100644 index 00000000000..79718891d51 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/scatterv_ts.c.in @@ -0,0 +1,109 @@ +/* + * 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-2013 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Scatterv"; + +void ompi_scatterv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, + MPI_Fint *displs, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, + MPI_Fint *recvtype, MPI_Fint *root, + MPI_Fint *comm, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_root = OMPI_FINT_2_INT(*root); + MPI_Datatype c_sendtype = NULL, c_recvtype = NULL, c_recvdatatype = NULL; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + int c_recvcount = 0; + OMPI_ARRAY_NAME_DECL(sendcounts); + OMPI_ARRAY_NAME_DECL(displs); + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + OMPI_COND_STATEMENT(int size = ompi_comm_size(c_comm)); + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_ARRAY_FINT_2_INT(sendcounts, size); + OMPI_ARRAY_FINT_2_INT(displs, size); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else if (MPI_PROC_NULL != c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + OMPI_COND_STATEMENT(int size = ompi_comm_size(c_comm)); + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_ARRAY_FINT_2_INT(sendcounts, size); + OMPI_ARRAY_FINT_2_INT(displs, size); + } + if (OMPI_IS_FORTRAN_IN_PLACE(recvbuf)) { + recvbuf = MPI_IN_PLACE; + } else { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } + + c_ierr = PMPI_Scatterv(sendbuf, + OMPI_ARRAY_NAME_CONVERT(sendcounts), + OMPI_ARRAY_NAME_CONVERT(displs), + c_sendtype, + recvbuf, c_recvcount, c_recvdatatype, + c_root, c_comm); + + if (c_recvdatatype != c_recvtype) { + ompi_datatype_destroy(&c_recvdatatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts); + OMPI_ARRAY_FINT_2_INT_CLEANUP(displs); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/send_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/send_f08.F90 deleted file mode 100644 index 25fecbffb7a..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/send_f08.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! -*- 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 "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Send_f08(buf,count,datatype,dest,tag,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_send_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_send_f(buf,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Send_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/send_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/send_init_ts.c.in new file mode 100644 index 00000000000..fbf6921fed9 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/send_init_ts.c.in @@ -0,0 +1,63 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Send_init"; + +void ompi_send_init_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + + c_ierr = PMPI_Send_init(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/send_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/send_ts.c.in new file mode 100644 index 00000000000..a5382770b13 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/send_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +/* void ompi_send_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *ierr) */ +PROTOTYPE VOID send(BUFFER x, COUNT count, DATATYPE datatype, RANK dest, + TAG tag, COMM comm) +{ + int c_ierr; + + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/sendrecv_replace_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/sendrecv_replace_ts.c.in new file mode 100644 index 00000000000..d2716f8a967 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/sendrecv_replace_ts.c.in @@ -0,0 +1,68 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Sendrecv_replace"; + +void ompi_sendrecv_replace_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *sendtag, + MPI_Fint *source, MPI_Fint *recvtag, + MPI_Fint *comm, MPI_Fint *status, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + MPI_Status c_status; + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Sendrecv_replace(OMPI_F2C_BOTTOM(buf), + OMPI_FINT_2_INT(*count), + c_datatype, + OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*sendtag), + OMPI_FINT_2_INT(*source), + OMPI_FINT_2_INT(*recvtag), + c_comm, &c_status); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr && + !OMPI_IS_FORTRAN_STATUS_IGNORE(status)) { + PMPI_Status_c2f(&c_status, status); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/sendrecv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/sendrecv_ts.c.in new file mode 100644 index 00000000000..793bf750d60 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/sendrecv_ts.c.in @@ -0,0 +1,84 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Sendrecv"; + +void ompi_sendrecv_ts(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + MPI_Fint *dest, MPI_Fint *sendtag, CFI_cdesc_t* x2, + MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *source, MPI_Fint *recvtag, MPI_Fint *comm, + MPI_Fint *status, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype); + MPI_Datatype c_recvdatatype, c_recvtype = PMPI_Type_f2c(*recvtype); + MPI_Status c_status; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1); + int c_sendcount = OMPI_FINT_2_INT(*sendcount); + void *recvbuf = OMPI_CFI_BASE_ADDR(x2); + int c_recvcount = OMPI_FINT_2_INT(*recvcount); + + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Sendrecv(OMPI_F2C_BOTTOM(sendbuf), c_sendcount, + c_senddatatype, + OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*sendtag), + OMPI_F2C_BOTTOM(recvbuf), c_recvcount, + c_recvdatatype, OMPI_FINT_2_INT(*source), + OMPI_FINT_2_INT(*recvtag), + c_comm, &c_status); + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + if (c_recvdatatype != c_recvtype) { + ompi_datatype_destroy(&c_recvdatatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr && + !OMPI_IS_FORTRAN_STATUS_IGNORE(status)) { + PMPI_Status_c2f(&c_status, status); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ssend_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ssend_init_ts.c.in new file mode 100644 index 00000000000..d80bf263469 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ssend_init_ts.c.in @@ -0,0 +1,61 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Ssend_init"; + +void ompi_ssend_init_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, + MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Ssend_init(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ssend_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ssend_ts.c.in new file mode 100644 index 00000000000..55b41d1944e --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ssend_ts.c.in @@ -0,0 +1,56 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Ssend"; + +void ompi_ssend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, + MPI_Fint *comm, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + int c_count = OMPI_FINT_2_INT(*count); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Ssend(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/testany.c.in b/ompi/mpi/fortran/use-mpi-f08/testany.c.in new file mode 100644 index 00000000000..4eb2c039f92 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/testany.c.in @@ -0,0 +1,79 @@ +/* + * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2020 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$ + */ + +PROTOTYPE VOID testany(INT count, REQUEST_ARRAY array_of_requests:count, INT indx, + LOGICAL_OUT flag, STATUS_OUT status) +{ + MPI_Request *c_req; + MPI_Status c_status; + int i, c_ierr; + OMPI_LOGICAL_NAME_DECL(flag); + OMPI_SINGLE_NAME_DECL(indx); + + /* Shortcut to avoid malloc(0) if *count==0. We're intentionally + skipping other parameter error checks. */ + if (OPAL_UNLIKELY(0 == OMPI_FINT_2_INT(*count))) { + *flag = OMPI_FORTRAN_VALUE_TRUE; + *indx = OMPI_INT_2_FINT(MPI_UNDEFINED); + PMPI_Status_c2f(&ompi_status_empty, status); + *ierr = OMPI_INT_2_FINT(MPI_SUCCESS); + return; + } + + c_req = (MPI_Request *) malloc(OMPI_FINT_2_INT(*count) * sizeof(MPI_Request)); + if (c_req == NULL) { + c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_NO_MEM, + FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + + for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) { + c_req[i] = PMPI_Request_f2c(array_of_requests[i]); + } + + c_ierr = PMPI_Testany(OMPI_FINT_2_INT(*count), c_req, + OMPI_SINGLE_NAME_CONVERT(indx), + OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag), + &c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_SINGLE_INT_2_LOGICAL(flag); + if (MPI_SUCCESS == c_ierr) { + + /* Increment index by one for fortran conventions. Note that + all Fortran compilers have FALSE==0; we just need to check + for any nonzero value (because TRUE is not always 1) */ + + OMPI_SINGLE_INT_2_FINT(indx); + if (*flag && + MPI_UNDEFINED != *(OMPI_SINGLE_NAME_CONVERT(indx))) { + array_of_requests[OMPI_INT_2_FINT(*indx)] = + c_req[OMPI_INT_2_FINT(*indx)]->req_f_to_c_index; + ++(*indx); + } + if (!OMPI_IS_FORTRAN_STATUS_IGNORE(status)) { + PMPI_Status_c2f(&c_status, status); + } + } + free(c_req); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/unpack_external_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/unpack_external_ts.c.in new file mode 100644 index 00000000000..4c455f370b1 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/unpack_external_ts.c.in @@ -0,0 +1,81 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/constants.h" +#include "ompi/mpi/fortran/base/constants.h" +#include "ompi/mpi/fortran/base/fortran_base_strings.h" + +static const char FUNC_NAME[] = "MPI_Unpack_external"; + +void ompi_unpack_external_ts(char* datarep, CFI_cdesc_t* x1, MPI_Aint *insize, + MPI_Aint *position, CFI_cdesc_t* x2, + MPI_Fint *outcount, MPI_Fint *datatype, + MPI_Fint *ierr, int datarep_len) +{ + int ret, c_ierr; + char *c_datarep; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + char *inbuf = OMPI_CFI_BASE_ADDR(x1); + void *outbuf = OMPI_CFI_BASE_ADDR(x2); + int c_outcount = OMPI_FINT_2_INT(*outcount); + + c_type = PMPI_Type_f2c(*datatype); + + /* Convert the fortran string */ + + if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len, + &c_datarep))) { + c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, ret, FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + return; + } + + OMPI_CFI_2_C(x2, c_outcount, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + return; + } + + c_ierr = PMPI_Unpack_external(c_datarep, inbuf, + *insize, + position, + OMPI_F2C_BOTTOM(outbuf), + c_outcount, + c_datatype); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + free(c_datarep); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/unpack_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/unpack_ts.c.in new file mode 100644 index 00000000000..b902716c5ab --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/unpack_ts.c.in @@ -0,0 +1,70 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/communicator/communicator.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" + +static const char FUNC_NAME[] = "MPI_Unpack"; + +void ompi_unpack_ts(CFI_cdesc_t* x1, MPI_Fint *insize, MPI_Fint *position, + CFI_cdesc_t* x2, MPI_Fint *outcount, MPI_Fint *datatype, + MPI_Fint *comm, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + OMPI_SINGLE_NAME_DECL(position); + char *inbuf = OMPI_CFI_BASE_ADDR(x1); + void *outbuf = OMPI_CFI_BASE_ADDR(x2); + int c_outcount = OMPI_FINT_2_INT(*outcount); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + OMPI_CFI_2_C(x2, c_outcount, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + OMPI_SINGLE_FINT_2_INT(position); + + c_ierr = PMPI_Unpack(inbuf, OMPI_FINT_2_INT(*insize), + OMPI_SINGLE_NAME_CONVERT(position), + OMPI_F2C_BOTTOM(outbuf), c_outcount, + c_datatype, c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_SINGLE_INT_2_FINT(position); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/waitall.c.in b/ompi/mpi/fortran/use-mpi-f08/waitall.c.in new file mode 100644 index 00000000000..fc88382a70c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/waitall.c.in @@ -0,0 +1,64 @@ +/* + * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2020 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$ + */ + +PROTOTYPE VOID waitall(INT count, REQUEST_ARRAY array_of_requests:count, + STATUS_ARRAY array_of_statuses) +{ + MPI_Request *c_req; + MPI_Status *c_status; + int i, c_ierr; + + /* Shortcut to avoid malloc(0) if *count==0. We're intentionally + skipping other parameter error checks. */ + if (OPAL_UNLIKELY(0 == OMPI_FINT_2_INT(*count))) { + *ierr = OMPI_INT_2_FINT(MPI_SUCCESS); + return; + } + + c_req = (MPI_Request *) malloc(OMPI_FINT_2_INT(*count) * + (sizeof(MPI_Request) + sizeof(MPI_Status))); + if (NULL == c_req) { + c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_NO_MEM, + FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + c_status = (MPI_Status*) (c_req + OMPI_FINT_2_INT(*count)); + + for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) { + c_req[i] = PMPI_Request_f2c(array_of_requests[i]); + } + + c_ierr = PMPI_Waitall(OMPI_FINT_2_INT(*count), c_req, c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) { + array_of_requests[i] = c_req[i]->req_f_to_c_index; + if (!OMPI_IS_FORTRAN_STATUSES_IGNORE(array_of_statuses) && + !OMPI_IS_FORTRAN_STATUS_IGNORE(&array_of_statuses[i])) { + PMPI_Status_c2f( &c_status[i], &array_of_statuses[i * (sizeof(MPI_Status) / sizeof(int))]); + } + } + } + free(c_req); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/waitall_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/waitall_f08.F90 deleted file mode 100644 index f07551d4c45..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/waitall_f08.F90 +++ /dev/null @@ -1,25 +0,0 @@ -! -*- 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_Waitall_f08(count,array_of_requests,array_of_statuses,ierror) - use :: mpi_f08_types, only : MPI_Request, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_waitall_f - implicit none - INTEGER, INTENT(IN) :: count - TYPE(MPI_Request), INTENT(INOUT) :: array_of_requests(count) - TYPE(MPI_Status), INTENT(OUT) :: array_of_statuses(*) - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_waitall_f(count,array_of_requests(:)%MPI_VAL,array_of_statuses,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Waitall_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/win_attach_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/win_attach_f08.F90 deleted file mode 100644 index fb78b337158..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/win_attach_f08.F90 +++ /dev/null @@ -1,25 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2015-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Win_attach_f08(win,base,size,ierror) - use :: mpi_f08_types, only : MPI_Win, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_win_attach_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: base - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: size - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_win_attach_f(win%MPI_VAL,base,size,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Win_attach_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/win_attach_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/win_attach_ts.c.in new file mode 100644 index 00000000000..36860dc492f --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/win_attach_ts.c.in @@ -0,0 +1,24 @@ +/* + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID win_attach(WIN win, BUFFER x, AINT size) +{ + int c_ierr; + MPI_Win c_win; + + c_win = PMPI_Win_f2c(*win); + if (OMPI_CFI_IS_CONTIGUOUS(x)) { + c_ierr = PMPI_Win_attach(c_win, OMPI_CFI_BASE_ADDR(x), *size); + } else { + c_ierr = MPI_ERR_BUFFER; + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/win_create_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/win_create_ts.c.in new file mode 100644 index 00000000000..dac46b3b8c5 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/win_create_ts.c.in @@ -0,0 +1,46 @@ +/* + * 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) 2007-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID win_create(BUFFER x, AINT size, DISP disp_unit, + INFO info, COMM comm, WIN_OUT win) +{ + int c_ierr; + MPI_Win c_win; + MPI_Info c_info; + MPI_Comm c_comm; + + c_comm = PMPI_Comm_f2c(*comm); + c_info = PMPI_Info_f2c(*info); + + if (OMPI_CFI_IS_CONTIGUOUS(x)) { + c_ierr = PMPI_Win_create(OMPI_CFI_BASE_ADDR(x), *size, + OMPI_FINT_2_INT(*disp_unit), + c_info, c_comm, &c_win); + } else { + c_ierr = MPI_ERR_BUFFER; + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *win = PMPI_Win_c2f(c_win); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/win_detach_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/win_detach_ts.c.in new file mode 100644 index 00000000000..ba25edd35a3 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/win_detach_ts.c.in @@ -0,0 +1,33 @@ +/* + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/win/win.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h" + +static const char FUNC_NAME[] = "MPI_Win_detach"; + +void ompi_win_detach_ts(MPI_Fint *win, CFI_cdesc_t *x, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Win c_win; + + c_win = PMPI_Win_f2c(*win); + if (OMPI_CFI_IS_CONTIGUOUS(x)) { + c_ierr = PMPI_Win_detach(c_win, OMPI_CFI_BASE_ADDR(x)); + } else { + c_ierr = MPI_ERR_BUFFER; + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +}