diff --git a/bindings/Fortran/f2c/adios2_f2c_io.cpp b/bindings/Fortran/f2c/adios2_f2c_io.cpp index dd5bec6317..74234501c4 100644 --- a/bindings/Fortran/f2c/adios2_f2c_io.cpp +++ b/bindings/Fortran/f2c/adios2_f2c_io.cpp @@ -236,7 +236,6 @@ void FC_GLOBAL(adios2_available_variables_f2c, cnamelist *info = new (cnamelist); info->names = adios2_available_variables(*io, &info->count); *vars_count = static_cast(info->count); - size_t maxlen = 0; for (size_t i = 0; i < info->count; ++i) { @@ -247,47 +246,10 @@ void FC_GLOBAL(adios2_available_variables_f2c, } } *max_var_name_len = static_cast(maxlen); - *namestruct = static_cast(reinterpret_cast(info)); *ierr = 0; } -void FC_GLOBAL(adios2_retrieve_variable_names_f2c, - ADIOS2_RETRIEVE_VARIABLE_NAMES_F2C)(int64_t *namestruct, - int *count, - int *max_name_len, - void *vnamelist, int *ierr, - int vnamelist_len) -{ - cnamelist *info = reinterpret_cast(*namestruct); - int cnt = info->count; - if (cnt > *count) - { - cnt = *count; - } - if (info != NULL && static_cast(*count) == info->count) - { - for (int i = 0; i < *count; i++) - { - char *fs = (char *)vnamelist + i * vnamelist_len; - size_t len = strlen(info->names[i]); - if (len > static_cast(vnamelist_len)) - { - len = static_cast(vnamelist_len); - } - // copy C string without '\0' - strncpy(fs, info->names[i], len); - // pad with spaces - memset(fs + len, ' ', vnamelist_len - len); - } - *ierr = 0; - } - else - { - *ierr = 1; - } -} - void FC_GLOBAL(adios2_available_attributes_f2c, ADIOS2_AVAILABLE_ATTRIBUTES_F2C)(adios2_io **io, int64_t *namestruct, @@ -314,35 +276,30 @@ void FC_GLOBAL(adios2_available_attributes_f2c, *ierr = 0; } -void FC_GLOBAL(adios2_retrieve_attribute_names_f2c, - ADIOS2_RETRIEVE_ATTRIBUTE_NAMES_F2C)(int64_t *namestruct, - int *count, - int *max_name_len, - void *anamelist, int *ierr, - int anamelist_len) +void FC_GLOBAL(adios2_retrieve_namelist_f2c, + ADIOS2_RETRIEVE_NAMELIST_F2C)(int64_t *namestruct, + void *namelist, int *ierr, + int namelist_len) { cnamelist *info = reinterpret_cast(*namestruct); - int cnt = info->count; - if (cnt > *count) - { - cnt = *count; - } - if (info != NULL && static_cast(*count) == info->count) + if (info != NULL) { - for (int i = 0; i < *count; i++) + for (size_t i = 0; i < info->count; i++) { - char *fs = (char *)anamelist + i * anamelist_len; + char *fs = (char *)namelist + i * namelist_len; size_t len = strlen(info->names[i]); - if (len > static_cast(anamelist_len)) + if (len > static_cast(namelist_len)) { - len = static_cast(anamelist_len); + len = static_cast(namelist_len); } // copy C string without '\0' strncpy(fs, info->names[i], len); // pad with spaces - memset(fs + len, ' ', anamelist_len - len); + memset(fs + len, ' ', namelist_len - len); } *ierr = 0; + delete (info); + *namestruct = 0; } else { diff --git a/bindings/Fortran/modules/adios2_io_mod.f90 b/bindings/Fortran/modules/adios2_io_mod.f90 index 4b1d5a45c1..32bcd7390c 100644 --- a/bindings/Fortran/modules/adios2_io_mod.f90 +++ b/bindings/Fortran/modules/adios2_io_mod.f90 @@ -136,26 +136,53 @@ subroutine adios2_set_transport_parameter(io, transport_index, key, value, & end subroutine - subroutine adios2_available_variables(io, nvars, varnamelist, ierr) + subroutine adios2_available_variables(io, namestruct, ierr) type(adios2_io), intent(in) :: io - integer, intent(out) :: nvars - character(len=:), dimension(:), allocatable, intent(out) :: varnamelist + type(adios2_namestruct), intent(out) :: namestruct integer, intent(out) :: ierr - integer(kind=8):: namestruct - integer :: count, max_name_len - - call adios2_available_variables_f2c(io%f2c, namestruct, count, & - max_name_len, ierr) + call adios2_available_variables_f2c(io%f2c, namestruct%f2c, & + namestruct%count, namestruct%max_name_len, ierr) if (ierr == 0) then - allocate(character(len=max_name_len) :: varnamelist(count)) + namestruct%valid = .true. endif + end subroutine + + subroutine adios2_retrieve_names(namestruct, namelist, ierr) + type(adios2_namestruct), intent(inout) :: namestruct + character(*), dimension(*), intent(inout) :: namelist + integer, intent(out) :: ierr - call adios2_retrieve_variable_names_f2c(namestruct, count, & - max_name_len, varnamelist, ierr) - nvars = count + if (namestruct%valid .and. namestruct%f2c > 0_8) then + call adios2_retrieve_namelist_f2c(namestruct%f2c, namelist, ierr) + else + write(*,*) "ADIOS2 Fortran ERROR: invalid namestruct when calling adios2_retrieve_names()" + endif + namestruct%valid = .false. end subroutine + ! + ! F2008 implementation that allows for allocating a character array inside + ! + ! subroutine adios2_available_variables(io, nvars, varnamelist, ierr) + ! type(adios2_io), intent(in) :: io + ! integer, intent(out) :: nvars + ! character(len=:), dimension(:), allocatable, intent(out) :: varnamelist + ! integer, intent(out) :: ierr + + ! integer(kind=8):: namestruct + ! integer :: count, max_name_len + + ! call adios2_available_variables_f2c(io%f2c, namestruct, count, & + ! max_name_len, ierr) + ! if (ierr == 0) then + ! allocate(character(len=max_name_len) :: varnamelist(count)) + ! endif + + ! call adios2_retrieve_variable_names_f2c(namestruct, varnamelist, ierr) + ! nvars = count + ! end subroutine + subroutine adios2_inquire_variable(variable, io, name, ierr) type(adios2_variable), intent(out) :: variable @@ -211,26 +238,38 @@ subroutine adios2_remove_all_variables(io, ierr) end subroutine - subroutine adios2_available_attributes(io, nattrs, attrnamelist, ierr) + subroutine adios2_available_attributes(io, namestruct, ierr) type(adios2_io), intent(in) :: io - integer, intent(out) :: nattrs - character(len=:), dimension(:), allocatable, intent(out) :: attrnamelist + type(adios2_namestruct), intent(out) :: namestruct integer, intent(out) :: ierr - integer(kind=8):: namestruct - integer :: count, max_name_len - - call adios2_available_attributes_f2c(io%f2c, namestruct, count, & - max_name_len, ierr) + call adios2_available_attributes_f2c(io%f2c, namestruct%f2c, & + namestruct%count, namestruct%max_name_len, ierr) if (ierr == 0) then - allocate(character(len=max_name_len) :: attrnamelist(count)) + namestruct%valid = .true. endif - - call adios2_retrieve_attribute_names_f2c(namestruct, count, & - max_name_len, attrnamelist, ierr) - nattrs = count end subroutine + ! subroutine adios2_available_attributes(io, nattrs, attrnamelist, ierr) + ! type(adios2_io), intent(in) :: io + ! integer, intent(out) :: nattrs + ! character(len=:), dimension(:), allocatable, intent(out) :: attrnamelist + ! integer, intent(out) :: ierr + + ! integer(kind=8):: namestruct + ! integer :: count, max_name_len + + ! call adios2_available_attributes_f2c(io%f2c, namestruct, count, & + ! max_name_len, ierr) + ! if (ierr == 0) then + ! allocate(character(len=max_name_len) :: attrnamelist(count)) + ! endif + + ! call adios2_retrieve_attribute_names_f2c(namestruct, count, & + ! max_name_len, attrnamelist, ierr) + ! nattrs = count + ! end subroutine + subroutine adios2_inquire_attribute(attribute, io, name, ierr) type(adios2_attribute), intent(out) :: attribute type(adios2_io), intent(in) :: io diff --git a/bindings/Fortran/modules/adios2_parameters_mod.f90 b/bindings/Fortran/modules/adios2_parameters_mod.f90 index c3376321d7..6be4deb2d9 100644 --- a/bindings/Fortran/modules/adios2_parameters_mod.f90 +++ b/bindings/Fortran/modules/adios2_parameters_mod.f90 @@ -127,4 +127,11 @@ module adios2_parameters_mod character(len=64):: type = '' end type + type adios2_namestruct + integer(kind=8):: f2c = 0_8 + logical :: valid = .false. + integer :: count + integer :: max_name_len + end type + end module diff --git a/source/adios2/toolkit/sst/util/CMakeLists.txt b/source/adios2/toolkit/sst/util/CMakeLists.txt index 7f7ec99db9..4b55128f50 100644 --- a/source/adios2/toolkit/sst/util/CMakeLists.txt +++ b/source/adios2/toolkit/sst/util/CMakeLists.txt @@ -25,3 +25,19 @@ target_include_directories(sst_conn_tool PRIVATE .. ../cp ) install(TARGETS sst_conn_tool EXPORT adios2 RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} COMPONENT adios2_tools-runtime ) + +# libfabric_mpi_compatibility +if(ADIOS2_HAVE_MPI AND ADIOS2_SST_HAVE_LIBFABRIC) + add_executable(libfabric_mpi_compatibility libfabric_mpi_compatibility.cpp) + target_link_libraries(libfabric_mpi_compatibility adios2_core_mpi adios2_core sst adios2::thirdparty::EVPath) + target_include_directories(libfabric_mpi_compatibility PRIVATE .. ../cp ../dp ) + set_property(TARGET libfabric_mpi_compatibility PROPERTY OUTPUT_NAME libfabric_mpi_compatibility${ADIOS2_EXECUTABLE_SUFFIX}) + + if(WIN32) + target_link_libraries(libfabric_mpi_compatibility getopt) + endif() + + install(TARGETS libfabric_mpi_compatibility EXPORT adios2 + RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} COMPONENT adios2_tools-runtime + ) +endif() diff --git a/source/adios2/toolkit/sst/util/libfabric_mpi_compatibility.cpp b/source/adios2/toolkit/sst/util/libfabric_mpi_compatibility.cpp new file mode 100644 index 0000000000..4e65818789 --- /dev/null +++ b/source/adios2/toolkit/sst/util/libfabric_mpi_compatibility.cpp @@ -0,0 +1,329 @@ +/* + * Distributed under the OSI-approved Apache License, Version 2.0. See + * accompanying file Copyright.txt for details. + * + * Test if the libfabric library is compatible with MPI + * + * Created on: Sept 7, 2021 + * Author: Norbert Podhorszki, pnorbert@ornl.gov + */ + +#include +#include +#include +#include +#include +#include + +#include +#include +#include +#include +#include + +#include "adios2/common/ADIOSConfig.h" +#include "adios2/helper/adiosCommMPI.h" +#include +#include +#include + +#include "sst.h" + +#include "cp_internal.h" + +MPI_Comm comm; // Communicator of producers OR consumers +int mpi_rank; // rank of process among producers OR consumers +int mpi_size; // number of processes of producers OR consumers +int wrank, wsize; // rank and size in world comm +int nProducers; +int nConsumers; +bool amProducer; +adios2::helper::Comm ADIOSComm; + +std::vector allranks; // array for MPI_Gather() + +void init_atoms(); +void do_listen(); +void do_connect(); + +void PrintUsage() noexcept +{ + std::cout << "Usage: libfabric_mpi_compatibility [producerRanks] " + << std::endl; +} + +int main(int argc, char *argv[]) +{ + MPI_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &wrank); + MPI_Comm_size(MPI_COMM_WORLD, &wsize); + + if (argc > 1) + { + amProducer = false; + nProducers = 0; + int j = 1; + char *end; + while (argc > j) + { + errno = 0; + unsigned long v = std::strtoul(argv[j], &end, 10); + if ((errno || (end != 0 && *end != '\0')) && !wrank) + { + std::string errmsg( + "ERROR: Invalid integer number in argument " + + std::to_string(j) + ": '" + std::string(argv[j]) + "'\n"); + PrintUsage(); + throw std::invalid_argument(errmsg); + } + if (v >= (unsigned long)wsize && !wrank) + { + std::string errmsg( + "ERROR: Argument " + std::to_string(j) + ": '" + + std::string(argv[j]) + + "' is larger than the total number of processes\n"); + PrintUsage(); + throw std::invalid_argument(errmsg); + } + if (v == (unsigned long)wrank) + { + amProducer = true; + ++nProducers; + } + ++j; + } + } + else + { + amProducer = (wrank < wsize / 2); + nProducers = wsize / 2; + } + nConsumers = wsize - nProducers; + std::cout << "Rank " << wrank << " is a " + << (amProducer ? "Producer" : "Consumer") << std::endl; + + MPI_Comm_split(MPI_COMM_WORLD, (int)amProducer, 0, &comm); + MPI_Comm_rank(comm, &mpi_rank); + MPI_Comm_size(comm, &mpi_size); + ADIOSComm = adios2::helper::CommWithMPI(comm); + MPI_Barrier(comm); + + if (!wrank) + { + allranks.resize(wsize); + } + + init_atoms(); + if (amProducer) + { + do_listen(); + } + else + { + do_connect(); + } + + MPI_Finalize(); + return 0; +} + +static atom_t TRANSPORT = -1; +static atom_t IP_PORT = -1; +/* static atom_t IP_HOSTNAME = -1; */ +static atom_t IP_ADDR = -1; +static atom_t ENET_PORT = -1; +/* static atom_t ENET_HOSTNAME = -1; */ +static atom_t ENET_ADDR = -1; + +void init_atoms() +{ + TRANSPORT = attr_atom_from_string("CM_TRANSPORT"); + /* IP_HOSTNAME = attr_atom_from_string("IP_HOST"); */ + IP_PORT = attr_atom_from_string("IP_PORT"); + IP_ADDR = attr_atom_from_string("IP_ADDR"); + /* ENET_HOSTNAME = attr_atom_from_string("CM_ENET_HOST"); */ + ENET_PORT = attr_atom_from_string("CM_ENET_PORT"); + ENET_ADDR = attr_atom_from_string("CM_ENET_ADDR"); +} + +void DecodeAttrList(const char *attrs, char **in_transport, char **in_ip, + char **in_hostname, int *in_port) +{ + attr_list listen_info = attr_list_from_string(attrs); + char *transport = NULL; + get_string_attr(listen_info, TRANSPORT, &transport); + if (transport == NULL) + { + /* must be sockets */ + struct in_addr addr; + int ip = -1, port = -1; + get_int_attr(listen_info, IP_PORT, &port); + get_int_attr(listen_info, IP_ADDR, &ip); + addr.s_addr = htonl(ip); + + if (in_ip) + *in_ip = strdup(inet_ntoa(addr)); + if (in_port) + *in_port = port; + } + else if (strcmp(transport, "enet") == 0) + { + /* reliable UDP transport "enet" */ + struct in_addr addr; + int ip = -1, port = -1; + get_int_attr(listen_info, ENET_PORT, &port); + get_int_attr(listen_info, ENET_ADDR, &ip); + addr.s_addr = htonl(ip); + if (in_ip) + *in_ip = strdup(inet_ntoa(addr)); + if (in_port) + *in_port = port; + } + else + { + dump_attr_list(listen_info); + } + if (in_transport && transport) + *in_transport = strdup(transport); +} + +void ConnToolCallback(int dataID, const char *attrs, const char *data) +{ + char *IP = NULL, *transport = NULL, *hostname = NULL; + int port = -1; + DecodeAttrList(attrs, &transport, &IP, &hostname, &port); + if (data) + { + std::cout << "Rank " << wrank << " callback data: " << data + << std::endl; + } + if (dataID == 0) + { + /* writer-side, prior to connection, giving info on listener network + * parameters */ + if (!transport) + { + std::cout << "Rank " << wrank + << " Producer is listening on TCP/IP connection at IP " + << IP << " port " << port << std::endl; + } + else if (strcmp(transport, "enet") == 0) + { + std::cout << "Rank " << wrank + << " Producer is listening on UDP connection at IP " << IP + << " port " << port << std::endl; + } + else + { + std::cout << "Rank " << wrank + << " Producer Warning, unknown control network transport " + "operating" + << std::endl; + } + printf("\tSst connection tool waiting for connection...\n\n"); + } + else if (dataID == 1) + { + /* reader-side, prior to connection, giving info on listener network + * parameters */ + if (!transport) + { + std::cout << "Rank " << wrank + << " Consumer set up for TCP/IP connection at IP " << IP + << " port " << port << std::endl; + } + else if (strcmp(transport, "enet") == 0) + { + std::cout << "Rank " << wrank + << " Consumer set up for UDP connection at IP " << IP + << " port " << port << std::endl; + } + else + { + std::cout << "Rank " << wrank + << " Consumer Warning, unknown control network transport " + "operating" + << std::endl; + } + } + else if (dataID == 2) + { + if (!transport) + { + std::cout + << "Rank " << wrank + << " Consumer Attempting TCP/IP connection to Producer at IP " + << IP << " port " << port << std::endl; + } + else if (strcmp(transport, "enet") == 0) + { + std::cout + << "Rank " << wrank + << " Consumer Attempting UDP connection to Producer at IP " + << IP << " port " << port << std::endl; + } + else + { + std::cout << "Rank " << wrank + << " Warning, unknown control network transport " + "operating" + << std::endl; + } + } +} + +void do_connect() +{ + struct _SstParams Params; + SstStream reader; + memset(&Params, 0, sizeof(Params)); + // SSTSetNetworkCallback(ConnToolCallback); + Params.RendezvousReaderCount = 1; + // Params.ControlTransport = strdup("enet"); + Params.DataTransport = strdup("rdma"); + Params.OpenTimeoutSecs = 10; + Params.RegistrationMethod = SstRegisterFile; + + reader = SstReaderOpen("libfabric_mpi_compatibility", &Params, &ADIOSComm); + + // MPI communication test (which also makes producers disconnect first, + // consumer last) + MPI_Gather(&wrank, 1, MPI_INT, allranks.data(), 1, MPI_INT, 0, + MPI_COMM_WORLD); + + if (reader) + { + std::cout << "Rank " << wrank << " Connection success, all is well!" + << std::endl; + SstReaderClose(reader); + } + else + { + std::cout << "Rank " << wrank + << " This connection did not succeed. Determine if IP " + "addresses in use are appropriate, or if firewalls or " + "other network-level artifacts might be causing a problem" + << std::endl; + } +} + +void do_listen() +{ + struct _SstParams Params; + SstStream writer; + memset(&Params, 0, sizeof(Params)); + Params.RegistrationMethod = SstRegisterFile; + // SSTSetNetworkCallback(ConnToolCallback); + Params.RendezvousReaderCount = 1; + // Params.ControlTransport = "enet"; + Params.DataTransport = strdup("rdma"); + writer = SstWriterOpen("libfabric_mpi_compatibility", &Params, &ADIOSComm); + std::cout << "Rank " << wrank << " Connection success, all is well!" + << std::endl; + + // MPI communication test + MPI_Gather(&wrank, 1, MPI_INT, allranks.data(), 1, MPI_INT, 0, + MPI_COMM_WORLD); + + SstWriterClose(writer); +} diff --git a/testing/adios2/bindings/fortran/TestBPWriteReadAttributes.F90 b/testing/adios2/bindings/fortran/TestBPWriteReadAttributes.F90 index dcf0daf18d..6209c60f0b 100644 --- a/testing/adios2/bindings/fortran/TestBPWriteReadAttributes.F90 +++ b/testing/adios2/bindings/fortran/TestBPWriteReadAttributes.F90 @@ -27,8 +27,9 @@ program TestBPWriteAttributes real, dimension(3) :: r32_array real(kind=8), dimension(3):: r64_array - character(len=:), dimension(:), allocatable :: attrnamelist - integer :: nattrs + type(adios2_namestruct) :: namestruct + character(len=4096), dimension(:), allocatable :: attrnamelist + ! Launch MPI call MPI_Init(ierr) @@ -109,15 +110,27 @@ program TestBPWriteAttributes call adios2_open(bpReader, ioRead, 'fattr_types.bp', adios2_mode_read, ierr) - call adios2_available_attributes(ioRead, nattrs, attrnamelist, ierr) - if (ierr /= 0) stop 'adios2_available_variables returned with error' - write(*,*) 'Number of attributes = ', nattrs - if (nattrs /= 14) stop 'adios2_available_attributes returned not the expected 14' - do i=1,nattrs - write(*,'("Var[",i2,"] = ",a20)') i, attrnamelist(i) + + ! Test getting list of attribute names + call adios2_available_attributes(ioRead, namestruct, ierr) + if (ierr /= 0) stop 'adios2_available_attributes returned with error' + if (.not.namestruct%valid) stop 'adios2_available_attributes returned invalid struct' + write(*,*) 'Number of attributes = ', namestruct%count + write(*,*) 'Max name length = ', namestruct%max_name_len + if (namestruct%count /= 14) stop 'adios2_available_attributes returned not the expected 14' + + allocate(attrnamelist(namestruct%count)) + + call adios2_retrieve_names(namestruct, attrnamelist, ierr) + if (ierr /= 0) stop 'adios2_retrieve_names returned with error' + do i=1,namestruct%count + write(*,'("Attr[",i2,"] = ",a20)') i, attrnamelist(i) end do deallocate(attrnamelist) + if (namestruct%f2c /= 0_8) stop 'namestruct f2c pointer is not null after adios2_retrieve_names()' + if (namestruct%valid) stop 'namestruct is not invalidated after adios2_retrieve_names()' + call adios2_inquire_attribute(attributes_in(1), ioRead, 'att_String', ierr) call adios2_inquire_attribute(attributes_in(2), ioRead, 'att_i8', ierr) diff --git a/testing/adios2/bindings/fortran/TestBPWriteTypes.F90 b/testing/adios2/bindings/fortran/TestBPWriteTypes.F90 index 492e3d8a17..c6d93b58f9 100644 --- a/testing/adios2/bindings/fortran/TestBPWriteTypes.F90 +++ b/testing/adios2/bindings/fortran/TestBPWriteTypes.F90 @@ -26,7 +26,8 @@ program TestBPWriteTypes integer(kind=4) :: ndims integer(kind=8), dimension(:), allocatable :: shape_in - character(len=:), dimension(:), allocatable :: varnamelist + character(len=4096), dimension(:), allocatable :: varnamelist + type(adios2_namestruct) :: namestruct integer :: nvars #if ADIOS2_USE_MPI @@ -235,15 +236,25 @@ program TestBPWriteTypes call adios2_steps(nsteps, bpReader, ierr) if(nsteps /= 3) stop 'ftypes.bp must have 3 steps' - call adios2_available_variables(ioRead, nvars, varnamelist, ierr) + call adios2_available_variables(ioRead, namestruct, ierr) if (ierr /= 0) stop 'adios2_available_variables returned with error' - write(*,*) 'Number of variables = ', nvars - if (nvars /= 14) stop 'adios2_available_variables returned not the expected 14' - do i=1,nvars + if (.not.namestruct%valid) stop 'adios2_available_variables returned invalid struct' + write(*,*) 'Number of variables = ', namestruct%count + write(*,*) 'Max name length = ', namestruct%max_name_len + if (namestruct%count /= 14) stop 'adios2_available_variables returned not the expected 14' + + allocate(varnamelist(namestruct%count)) + + call adios2_retrieve_names(namestruct, varnamelist, ierr) + if (ierr /= 0) stop 'adios2_retrieve_names returned with error' + do i=1,namestruct%count write(*,'("Var[",i2,"] = ",a12)') i, varnamelist(i) end do deallocate(varnamelist) + if (namestruct%f2c /= 0_8) stop 'namestruct f2c pointer is not null after adios2_retrieve_names()' + if (namestruct%valid) stop 'namestruct is not invalidated after adios2_retrieve_names()' + call adios2_inquire_variable(variables(1), ioRead, "var_I8", ierr) if (variables(1)%name /= 'var_I8') stop 'var_I8 not recognized'