diff --git a/bindings/Fortran/f2c/adios2_f2c_io.cpp b/bindings/Fortran/f2c/adios2_f2c_io.cpp index e9c3c4523d..dd5bec6317 100644 --- a/bindings/Fortran/f2c/adios2_f2c_io.cpp +++ b/bindings/Fortran/f2c/adios2_f2c_io.cpp @@ -10,6 +10,7 @@ #include "adios2_f2c_common.h" +#include #include //std::invalid_argument #include //strcpy @@ -220,6 +221,135 @@ void FC_GLOBAL(adios2_define_variable_f2c, ADIOS2_DEFINE_VARIABLE_F2C)( } } +struct cnamelist +{ + char **names; + size_t count; +}; + +void FC_GLOBAL(adios2_available_variables_f2c, + ADIOS2_AVAILABLE_VARIABLES_F2C)(adios2_io **io, + int64_t *namestruct, + int *vars_count, + int *max_var_name_len, int *ierr) +{ + 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) + { + auto l = strlen(info->names[i]); + if (l > maxlen) + { + maxlen = l; + } + } + *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, + int *attrs_count, + int *max_attr_name_len, + int *ierr) +{ + cnamelist *info = new (cnamelist); + info->names = adios2_available_attributes(*io, &info->count); + *attrs_count = static_cast(info->count); + + size_t maxlen = 0; + for (size_t i = 0; i < info->count; ++i) + { + auto l = strlen(info->names[i]); + if (l > maxlen) + { + maxlen = l; + } + } + *max_attr_name_len = static_cast(maxlen); + + *namestruct = static_cast(reinterpret_cast(info)); + *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) +{ + 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 *)anamelist + i * anamelist_len; + size_t len = strlen(info->names[i]); + if (len > static_cast(anamelist_len)) + { + len = static_cast(anamelist_len); + } + // copy C string without '\0' + strncpy(fs, info->names[i], len); + // pad with spaces + memset(fs + len, ' ', anamelist_len - len); + } + *ierr = 0; + } + else + { + *ierr = 1; + } +} + void FC_GLOBAL(adios2_inquire_variable_f2c, ADIOS2_INQUIRE_VARIABLE_F2C)(adios2_variable **variable, adios2_io **io, const char *name, diff --git a/bindings/Fortran/modules/adios2_io_mod.f90 b/bindings/Fortran/modules/adios2_io_mod.f90 index 37840517f1..4b1d5a45c1 100644 --- a/bindings/Fortran/modules/adios2_io_mod.f90 +++ b/bindings/Fortran/modules/adios2_io_mod.f90 @@ -135,6 +135,28 @@ subroutine adios2_set_transport_parameter(io, transport_index, key, value, & ierr) end subroutine + + 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, count, & + max_name_len, varnamelist, ierr) + nvars = count + end subroutine + + subroutine adios2_inquire_variable(variable, io, name, ierr) type(adios2_variable), intent(out) :: variable type(adios2_io), intent(in) :: io @@ -189,6 +211,25 @@ subroutine adios2_remove_all_variables(io, ierr) 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 diff --git a/testing/adios2/bindings/fortran/TestBPWriteReadAttributes.F90 b/testing/adios2/bindings/fortran/TestBPWriteReadAttributes.F90 index 592e0807f8..dcf0daf18d 100644 --- a/testing/adios2/bindings/fortran/TestBPWriteReadAttributes.F90 +++ b/testing/adios2/bindings/fortran/TestBPWriteReadAttributes.F90 @@ -27,6 +27,8 @@ program TestBPWriteAttributes real, dimension(3) :: r32_array real(kind=8), dimension(3):: r64_array + character(len=:), dimension(:), allocatable :: attrnamelist + integer :: nattrs ! Launch MPI call MPI_Init(ierr) @@ -107,6 +109,16 @@ 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) + end do + deallocate(attrnamelist) + + call adios2_inquire_attribute(attributes_in(1), ioRead, 'att_String', ierr) call adios2_inquire_attribute(attributes_in(2), ioRead, 'att_i8', ierr) call adios2_inquire_attribute(attributes_in(3), ioRead, 'att_i16', ierr) diff --git a/testing/adios2/bindings/fortran/TestBPWriteTypes.F90 b/testing/adios2/bindings/fortran/TestBPWriteTypes.F90 index 4aaa8a21bc..492e3d8a17 100644 --- a/testing/adios2/bindings/fortran/TestBPWriteTypes.F90 +++ b/testing/adios2/bindings/fortran/TestBPWriteTypes.F90 @@ -26,6 +26,8 @@ program TestBPWriteTypes integer(kind=4) :: ndims integer(kind=8), dimension(:), allocatable :: shape_in + character(len=:), dimension(:), allocatable :: varnamelist + integer :: nvars #if ADIOS2_USE_MPI ! Launch MPI @@ -233,6 +235,16 @@ 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) + 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 + write(*,'("Var[",i2,"] = ",a12)') i, varnamelist(i) + end do + deallocate(varnamelist) + + call adios2_inquire_variable(variables(1), ioRead, "var_I8", ierr) if (variables(1)%name /= 'var_I8') stop 'var_I8 not recognized' if (variables(1)%type /= adios2_type_integer1) stop 'var_I8 type not recognized'