Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fortran backto f90 #2857

Closed
wants to merge 2 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
67 changes: 12 additions & 55 deletions bindings/Fortran/f2c/adios2_f2c_io.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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<int>(info->count);

size_t maxlen = 0;
for (size_t i = 0; i < info->count; ++i)
{
Expand All @@ -247,47 +246,10 @@ void FC_GLOBAL(adios2_available_variables_f2c,
}
}
*max_var_name_len = static_cast<int>(maxlen);

*namestruct = static_cast<int64_t>(reinterpret_cast<std::uintptr_t>(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<cnamelist *>(*namestruct);
int cnt = info->count;
if (cnt > *count)
{
cnt = *count;
}
if (info != NULL && static_cast<size_t>(*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<size_t>(vnamelist_len))
{
len = static_cast<size_t>(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,
Expand All @@ -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<cnamelist *>(*namestruct);
int cnt = info->count;
if (cnt > *count)
{
cnt = *count;
}
if (info != NULL && static_cast<size_t>(*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<size_t>(anamelist_len))
if (len > static_cast<size_t>(namelist_len))
{
len = static_cast<size_t>(anamelist_len);
len = static_cast<size_t>(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
{
Expand Down
89 changes: 64 additions & 25 deletions bindings/Fortran/modules/adios2_io_mod.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
7 changes: 7 additions & 0 deletions bindings/Fortran/modules/adios2_parameters_mod.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
16 changes: 16 additions & 0 deletions source/adios2/toolkit/sst/util/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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()
Loading