diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index b9787ba1e..1d056e1dc 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -132,6 +132,34 @@ module hdf5_interface logical(C_BOOL), intent(in) :: indep end subroutine read_llong_c + subroutine write_attr_double_c(obj_id, ndim, dims, name, buffer) & + bind(C, name='write_attr_double') + import HID_T, HSIZE_T, C_INT, C_DOUBLE, C_CHAR + integer(HID_T), value :: obj_id + integer(C_INT), value :: ndim + integer(HSIZE_T), intent(in) :: dims(*) + character(kind=C_CHAR), intent(in) :: name(*) + real(C_DOUBLE), intent(in) :: buffer(*) + end subroutine write_attr_double_c + + subroutine write_attr_int_c(obj_id, ndim, dims, name, buffer) & + bind(C, name='write_attr_int') + import HID_T, HSIZE_T, C_INT, C_CHAR + integer(HID_T), value :: obj_id + integer(C_INT), value :: ndim + integer(HSIZE_T), intent(in) :: dims(*) + character(kind=C_CHAR), intent(in) :: name(*) + integer(C_INT), intent(in) :: buffer(*) + end subroutine write_attr_int_c + + subroutine write_attr_string_c(obj_id, name, buffer) & + bind(C, name='write_attr_string') + import HID_T, C_CHAR + integer(HID_T), value :: obj_id + character(kind=C_CHAR), intent(in) :: name(*) + character(kind=C_CHAR), intent(in) :: buffer(*) + end subroutine write_attr_string_c + subroutine write_double_c(group_id, ndim, dims, name, buffer, indep) & bind(C, name='write_double') import HID_T, HSIZE_T, C_INT, C_DOUBLE, C_CHAR, C_BOOL @@ -1141,41 +1169,8 @@ contains character(*), intent(in) :: name ! name of attribute character(*), intent(in), target :: buffer ! string to write - integer :: hdf5_err - integer(HID_T) :: dspace_id - integer(HID_T) :: attr_id - integer(HID_T) :: filetype - integer(SIZE_T) :: i - integer(SIZE_T) :: n - character(kind=C_CHAR), allocatable, target :: temp_buffer(:) - type(c_ptr) :: f_ptr - ! Create datatype for HDF5 file based on C char - n = len_trim(buffer) - if (n > 0) then - call h5tcopy_f(H5T_C_S1, filetype, hdf5_err) - call h5tset_size_f(filetype, n, hdf5_err) - - ! Create memory space and attribute - call h5screate_f(H5S_SCALAR_F, dspace_id, hdf5_err) - call h5acreate_f(obj_id, trim(name), filetype, dspace_id, & - attr_id, hdf5_err) - - ! Copy string to temporary buffer - allocate(temp_buffer(n)) - do i = 1, n - temp_buffer(i) = buffer(i:i) - end do - - ! Write attribute - f_ptr = c_loc(buffer(1:1)) - call h5awrite_f(attr_id, filetype, f_ptr, hdf5_err) - - ! Close attribute - call h5aclose_f(attr_id, hdf5_err) - call h5sclose_f(dspace_id, hdf5_err) - call h5tclose_f(filetype, hdf5_err) - end if + call write_attr_string_c(obj_id, to_c_string(name), to_c_string(buffer)) end subroutine write_attribute_string subroutine read_attribute_double(buffer, obj_id, name) @@ -1198,18 +1193,11 @@ contains character(*), intent(in) :: name real(8), intent(in), target :: buffer - integer :: hdf5_err - integer(HID_T) :: dspace_id - integer(HID_T) :: attr_id - type(C_PTR) :: f_ptr + integer(HSIZE_T) :: dims(0) + real(C_DOUBLE) :: buffer_(1) - call h5screate_f(H5S_SCALAR_F, dspace_id, hdf5_err) - call h5acreate_f(obj_id, trim(name), H5T_NATIVE_DOUBLE, dspace_id, & - attr_id, hdf5_err) - f_ptr = c_loc(buffer) - call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) - call h5aclose_f(attr_id, hdf5_err) - call h5sclose_f(dspace_id, hdf5_err) + buffer_(1) = buffer + call write_attr_double_c(obj_id, 0, dims, to_c_string(name), buffer_) end subroutine write_attribute_double subroutine read_attribute_double_1D(buffer, obj_id, name) @@ -1257,30 +1245,10 @@ contains integer(HSIZE_T) :: dims(1) - dims(:) = shape(buffer) - call write_attribute_double_1D_explicit(obj_id, dims, name, buffer) + dims(1) = size(buffer) + call write_attr_double_c(obj_id, 1, dims, to_c_string(name), buffer) end subroutine write_attribute_double_1D - subroutine write_attribute_double_1D_explicit(obj_id, dims, name, buffer) - integer(HID_T), intent(in) :: obj_id - integer(HSIZE_T), intent(in) :: dims(1) - character(*), intent(in) :: name - real(8), target, intent(in) :: buffer(dims(1)) - - integer :: hdf5_err - integer(HID_T) :: dspace_id - integer(HID_T) :: attr_id - type(C_PTR) :: f_ptr - - call h5screate_simple_f(1, dims, dspace_id, hdf5_err) - call h5acreate_f(obj_id, trim(name), H5T_NATIVE_DOUBLE, dspace_id, & - attr_id, hdf5_err) - f_ptr = c_loc(buffer) - call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) - call h5aclose_f(attr_id, hdf5_err) - call h5sclose_f(dspace_id, hdf5_err) - end subroutine write_attribute_double_1D_explicit - subroutine read_attribute_double_2D(buffer, obj_id, name) real(8), target, allocatable, intent(inout) :: buffer(:,:) integer(HID_T), intent(in) :: obj_id @@ -1339,18 +1307,11 @@ contains character(*), intent(in) :: name integer, intent(in), target :: buffer - integer :: hdf5_err - integer(HID_T) :: dspace_id - integer(HID_T) :: attr_id - type(C_PTR) :: f_ptr + integer(HSIZE_T) :: dims(0) + integer(C_INT) :: buffer_(1) - call h5screate_f(H5S_SCALAR_F, dspace_id, hdf5_err) - call h5acreate_f(obj_id, trim(name), H5T_NATIVE_INTEGER, dspace_id, & - attr_id, hdf5_err) - f_ptr = c_loc(buffer) - call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) - call h5aclose_f(attr_id, hdf5_err) - call h5sclose_f(dspace_id, hdf5_err) + buffer_(1) = buffer + call write_attr_int_c(obj_id, 0, dims, to_c_string(name), buffer_) end subroutine write_attribute_integer subroutine read_attribute_integer_1D(buffer, obj_id, name) @@ -1398,30 +1359,10 @@ contains integer(HSIZE_T) :: dims(1) - dims(:) = shape(buffer) - call write_attribute_integer_1D_explicit(obj_id, dims, name, buffer) + dims(1) = size(buffer) + call write_attr_int_c(obj_id, 1, dims, to_c_string(name), buffer) end subroutine write_attribute_integer_1D - subroutine write_attribute_integer_1D_explicit(obj_id, dims, name, buffer) - integer(HID_T), intent(in) :: obj_id - integer(HSIZE_T), intent(in) :: dims(1) - character(*), intent(in) :: name - integer, target, intent(in) :: buffer(dims(1)) - - integer :: hdf5_err - integer(HID_T) :: dspace_id - integer(HID_T) :: attr_id - type(C_PTR) :: f_ptr - - call h5screate_simple_f(1, dims, dspace_id, hdf5_err) - call h5acreate_f(obj_id, trim(name), H5T_NATIVE_INTEGER, dspace_id, & - attr_id, hdf5_err) - f_ptr = c_loc(buffer) - call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) - call h5aclose_f(attr_id, hdf5_err) - call h5sclose_f(dspace_id, hdf5_err) - end subroutine write_attribute_integer_1D_explicit - subroutine read_attribute_integer_2D(buffer, obj_id, name) integer, target, allocatable, intent(inout) :: buffer(:,:) integer(HID_T), intent(in) :: obj_id diff --git a/src/hdf5_interface.cpp b/src/hdf5_interface.cpp index 0b8000f70..f482285f2 100644 --- a/src/hdf5_interface.cpp +++ b/src/hdf5_interface.cpp @@ -161,7 +161,7 @@ open_group(hid_t group_id, const char* name) void -read_data(hid_t obj_id, const char* name, hid_t mem_type_id, +read_dataset(hid_t obj_id, const char* name, hid_t mem_type_id, void* buffer, bool indep) { hid_t dset = obj_id; @@ -191,27 +191,84 @@ read_data(hid_t obj_id, const char* name, hid_t mem_type_id, void read_double(hid_t obj_id, const char* name, double* buffer, bool indep) { - read_data(obj_id, name, H5T_NATIVE_DOUBLE, buffer, indep); + read_dataset(obj_id, name, H5T_NATIVE_DOUBLE, buffer, indep); } void read_int(hid_t obj_id, const char* name, int* buffer, bool indep) { - read_data(obj_id, name, H5T_NATIVE_INT, buffer, indep); + read_dataset(obj_id, name, H5T_NATIVE_INT, buffer, indep); } void read_llong(hid_t obj_id, const char* name, long long* buffer, bool indep) { - read_data(obj_id, name, H5T_NATIVE_LLONG, buffer, indep); + read_dataset(obj_id, name, H5T_NATIVE_LLONG, buffer, indep); } void -write_data(hid_t group_id, int ndim, const hsize_t* dims, const char* name, - hid_t mem_type_id, const void* buffer, bool indep) +write_attr(hid_t obj_id, int ndim, const hsize_t* dims, const char* name, + hid_t mem_type_id, const void* buffer) +{ + // If array is given, create a simple dataspace. Otherwise, create a scalar + // datascape. + hid_t dspace; + if (ndim > 0) { + dspace = H5Screate_simple(ndim, dims, nullptr); + } else { + dspace = H5Screate(H5S_SCALAR); + } + + // Create attribute and Write data + hid_t attr = H5Acreate(obj_id, name, mem_type_id, dspace, + H5P_DEFAULT, H5P_DEFAULT); + H5Awrite(attr, mem_type_id, buffer); + + // Free resources + H5Aclose(attr); + H5Sclose(dspace); +} + + +void +write_attr_double(hid_t obj_id, int ndim, const hsize_t* dims, const char* name, + const double* buffer) +{ + write_attr(obj_id, ndim, dims, name, H5T_NATIVE_DOUBLE, buffer); +} + + +void +write_attr_int(hid_t obj_id, int ndim, const hsize_t* dims, const char* name, + const int* buffer) +{ + write_attr(obj_id, ndim, dims, name, H5T_NATIVE_INT, buffer); +} + + +void +write_attr_string(hid_t obj_id, const char* name, const char* buffer) +{ + size_t n = strlen(buffer); + if (n > 0) { + // Set up appropriate datatype for a fixed-length string + hid_t datatype = H5Tcopy(H5T_C_S1); + H5Tset_size(datatype, n); + + write_attr(obj_id, 0, nullptr, name, datatype, buffer); + + // Free resources + H5Tclose(datatype); + } +} + + +void +write_dataset(hid_t group_id, int ndim, const hsize_t* dims, const char* name, + hid_t mem_type_id, const void* buffer, bool indep) { // If array is given, create a simple dataspace. Otherwise, create a scalar // datascape. @@ -252,7 +309,7 @@ void write_double(hid_t group_id, int ndim, const hsize_t* dims, const char* name, const double* buffer, bool indep) { - write_data(group_id, ndim, dims, name, H5T_NATIVE_DOUBLE, buffer, indep); + write_dataset(group_id, ndim, dims, name, H5T_NATIVE_DOUBLE, buffer, indep); } @@ -260,7 +317,7 @@ void write_int(hid_t group_id, int ndim, const hsize_t* dims, const char* name, const int* buffer, bool indep) { - write_data(group_id, ndim, dims, name, H5T_NATIVE_INT, buffer, indep); + write_dataset(group_id, ndim, dims, name, H5T_NATIVE_INT, buffer, indep); } @@ -268,7 +325,7 @@ void write_llong(hid_t group_id, int ndim, const hsize_t* dims, const char* name, const long long* buffer, bool indep) { - write_data(group_id, ndim, dims, name, H5T_NATIVE_LLONG, buffer, indep); + write_dataset(group_id, ndim, dims, name, H5T_NATIVE_LLONG, buffer, indep); } @@ -281,7 +338,7 @@ write_string(hid_t group_id, int ndim, const hsize_t* dims, size_t slen, hid_t datatype = H5Tcopy(H5T_C_S1); H5Tset_size(datatype, slen); - write_data(group_id, ndim, dims, name, datatype, buffer, indep); + write_dataset(group_id, ndim, dims, name, datatype, buffer, indep); // Free resources H5Tclose(datatype); diff --git a/src/hdf5_interface.h b/src/hdf5_interface.h index 11f26a5f1..615bed24c 100644 --- a/src/hdf5_interface.h +++ b/src/hdf5_interface.h @@ -41,8 +41,8 @@ write_double_1D(hid_t group_id, char const *name, H5Dclose(dataset); } -void read_data(hid_t obj_id, const char* name, double* buffer, - hid_t mem_type_id, bool indep); +void read_dataset(hid_t obj_id, const char* name, double* buffer, + hid_t mem_type_id, bool indep); extern "C" void read_double(hid_t obj_id, const char* name, double* buffer, bool indep); extern "C" void read_int(hid_t obj_id, const char* name, int* buffer, @@ -50,8 +50,17 @@ extern "C" void read_int(hid_t obj_id, const char* name, int* buffer, extern "C" void read_llong(hid_t obj_id, const char* name, long long* buffer, bool indep); -void write_data(hid_t group_id, int ndim, const hsize_t* dims, const char* name, - hid_t mem_type_id, const void* buffer, bool indep); +void write_attr(hid_t obj_id, int ndim, const hsize_t* dims, const char* name, + hid_t mem_type_id, const void* buffer); +extern "C" void write_attr_double(hid_t obj_id, int ndim, const hsize_t* dims, + const char* name, const double* buffer); +extern "C" void write_attr_int(hid_t obj_id, int ndim, const hsize_t* dims, + const char* name, const int* buffer); +extern "C" void write_attr_string(hid_t obj_id, const char* name, const char* buffer); + + +void write_dataset(hid_t group_id, int ndim, const hsize_t* dims, const char* name, + hid_t mem_type_id, const void* buffer, bool indep); extern "C" void write_double(hid_t group_id, int ndim, const hsize_t* dims, const char* name, const double* buffer, bool indep); extern "C" void write_int(hid_t group_id, int ndim, const hsize_t* dims,