Fix dimension bug and implement write_string_1D using write_string_c

This commit is contained in:
Paul Romano 2018-04-18 13:38:34 -05:00
parent f8e7d52d39
commit cc5e99eac4
3 changed files with 69 additions and 83 deletions

View file

@ -165,10 +165,13 @@ module hdf5_interface
logical(C_BOOL), intent(in) :: indep
end subroutine write_llong_c
subroutine write_string_c(group_id, name, buffer, indep) &
subroutine write_string_c(group_id, ndim, dims, slen, name, buffer, indep) &
bind(C, name='write_string')
import HID_T, HSIZE_T, C_CHAR, C_BOOL
import HID_T, HSIZE_T, C_INT, C_CHAR, C_BOOL, C_SIZE_T
integer(HID_T), value :: group_id
integer(C_INT), value :: ndim
integer(HSIZE_T), intent(in) :: dims(*)
integer(C_SIZE_T), value :: slen
character(kind=C_CHAR), intent(in) :: name(*)
character(kind=C_CHAR), intent(in) :: buffer(*)
logical(C_BOOL), intent(in) :: indep
@ -466,7 +469,7 @@ contains
integer(HSIZE_T) :: dims(1)
logical(C_BOOL) :: indep_
dims(:) = shape(buffer)
dims(1) = size(buffer)
indep_ = .false.
if (present(indep)) indep_ = indep
@ -482,7 +485,10 @@ contains
integer(HSIZE_T) :: dims(2)
logical(C_BOOL) :: indep_
dims(:) = shape(buffer)
! Reverse shape of array since it will be written from C
dims(1) = size(buffer, 2)
dims(2) = size(buffer, 1)
indep_ = .false.
if (present(indep)) indep_ = indep
@ -498,7 +504,11 @@ contains
integer(HSIZE_T) :: dims(3)
logical(C_BOOL) :: indep_
dims(:) = shape(buffer)
! Reverse shape of array since it will be written from C
dims(1) = size(buffer, 3)
dims(2) = size(buffer, 2)
dims(3) = size(buffer, 1)
indep_ = .false.
if (present(indep)) indep_ = indep
@ -514,7 +524,12 @@ contains
integer(HSIZE_T) :: dims(4)
logical(C_BOOL) :: indep_
dims(:) = shape(buffer)
! Reverse shape of array since it will be written from C
dims(1) = size(buffer, 4)
dims(2) = size(buffer, 3)
dims(3) = size(buffer, 2)
dims(4) = size(buffer, 1)
indep_ = .false.
if (present(indep)) indep_ = indep
@ -667,7 +682,7 @@ contains
integer(HSIZE_T) :: dims(1)
logical(C_BOOL) :: indep_
dims(:) = shape(buffer)
dims(1) = size(buffer)
indep_ = .false.
if (present(indep)) indep_ = indep
@ -683,7 +698,10 @@ contains
integer(HSIZE_T) :: dims(2)
logical(C_BOOL) :: indep_
dims(:) = shape(buffer)
! Reverse shape of array since it will be written from C
dims(1) = size(buffer, 2)
dims(2) = size(buffer, 1)
indep_ = .false.
if (present(indep)) indep_ = indep
@ -699,7 +717,11 @@ contains
integer(HSIZE_T) :: dims(3)
logical(C_BOOL) :: indep_
dims(:) = shape(buffer)
! Reverse shape of array since it will be written from C
dims(1) = size(buffer, 3)
dims(2) = size(buffer, 2)
dims(3) = size(buffer, 1)
indep_ = .false.
if (present(indep)) indep_ = indep
@ -715,7 +737,12 @@ contains
integer(HSIZE_T) :: dims(4)
logical(C_BOOL) :: indep_
dims(:) = shape(buffer)
! Reverse shape of array since it will be written from C
dims(1) = size(buffer, 4)
dims(2) = size(buffer, 3)
dims(3) = size(buffer, 2)
dims(4) = size(buffer, 1)
indep_ = .false.
if (present(indep)) indep_ = indep
@ -897,12 +924,16 @@ contains
character(*), intent(in), target :: buffer ! read data to here
logical, intent(in), optional :: indep ! independent I/O
integer(HSIZE_T) :: dims(0)
integer(C_SIZE_T) :: slen
logical(C_BOOL) :: indep_
indep_ = .false.
if (present(indep)) indep_ = indep
slen = len_trim(buffer)
call write_string_c(group_id, to_c_string(name), to_c_string(buffer), indep_)
call write_string_c(group_id, 0, dims, slen, to_c_string(name), &
to_c_string(buffer), indep_)
end subroutine write_string
!===============================================================================
@ -988,74 +1019,28 @@ contains
character(*), intent(in), target :: buffer(:) ! read data to here
logical, intent(in), optional :: indep ! independent I/O
integer :: i
integer(HSIZE_T) :: dims(1)
integer(C_SIZE_T) :: m
logical(C_BOOL) :: indep_
character(kind=C_CHAR), allocatable :: buffer_(:)
dims(:) = shape(buffer)
if (present(indep)) then
call write_string_1D_explicit(group_id, dims, name, buffer, indep)
else
call write_string_1D_explicit(group_id, dims, name, buffer)
end if
indep_ = .false.
if (present(indep)) indep_ = indep
! Copy array of characters into an array of C chars with the right memory
! layout
dims(1) = size(buffer)
m = maxval(len_trim(buffer)) + 1
allocate(buffer_(dims(1)*m))
do i = 0, dims(1) - 1
buffer_(i*m+1 : (i+1)*m) = to_c_string(buffer(i+1))
end do
call write_string_c(group_id, 1, dims, m, to_c_string(name), &
buffer_, indep_)
end subroutine write_string_1D
subroutine write_string_1D_explicit(group_id, dims, name, buffer, indep)
integer(HID_T), intent(in) :: group_id
integer(HSIZE_T), intent(in) :: dims(1)
character(*), intent(in) :: name
character(*), intent(in), target :: buffer(dims(1))
logical, intent(in), optional :: indep ! independent I/O
integer :: hdf5_err
integer :: data_xfer_mode
#ifdef PHDF5
integer(HID_T) :: plist ! property list
#endif
integer(HID_T) :: dset ! data set handle
integer(HID_T) :: dspace ! data or file space handle
integer(HID_T) :: filetype
integer(HID_T) :: memtype
integer(SIZE_T) :: n
type(c_ptr) :: f_ptr
! Set up collective vs. independent I/O
data_xfer_mode = H5FD_MPIO_COLLECTIVE_F
if (present(indep)) then
if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F
end if
! Create datatype for HDF5 file based on C char
n = maxval(len_trim(buffer))
call h5tcopy_f(H5T_C_S1, filetype, hdf5_err)
call h5tset_size_f(filetype, n + 1, hdf5_err)
! Create datatype in memory based on Fortran character
call h5tcopy_f(H5T_FORTRAN_S1, memtype, hdf5_err)
call h5tset_size_f(memtype, int(len(buffer(1)), SIZE_T), hdf5_err)
! Create dataspace/dataset
call h5screate_simple_f(1, dims, dspace, hdf5_err)
call h5dcreate_f(group_id, trim(name), filetype, dspace, dset, hdf5_err)
! Get pointer to start of string
f_ptr = c_loc(buffer(1)(1:1))
if (using_mpio_device(group_id)) then
#ifdef PHDF5
call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err)
call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err)
if (n > 0) call h5dwrite_f(dset, memtype, f_ptr, hdf5_err, xfer_prp=plist)
call h5pclose_f(plist, hdf5_err)
#endif
else
if (n > 0) call h5dwrite_f(dset, memtype, f_ptr, hdf5_err)
end if
call h5dclose_f(dset, hdf5_err)
call h5sclose_f(dspace, hdf5_err)
call h5tclose_f(memtype, hdf5_err)
call h5tclose_f(filetype, hdf5_err)
end subroutine write_string_1D_explicit
!===============================================================================
! READ_STRING_1D reads string 1-D array data
!===============================================================================

View file

@ -273,15 +273,15 @@ write_llong(hid_t group_id, int ndim, const hsize_t* dims, const char* name,
void
write_string(hid_t group_id, char const* name, const char* buffer, bool indep)
write_string(hid_t group_id, int ndim, const hsize_t* dims, size_t slen,
const char* name, const char* buffer, bool indep)
{
size_t buffer_len = strlen(buffer);
if (buffer_len > 0) {
if (slen > 0) {
// Set up appropriate datatype for a fixed-length string
hid_t datatype = H5Tcopy(H5T_C_S1);
H5Tset_size(datatype, buffer_len);
H5Tset_size(datatype, slen);
write_data(group_id, 0, nullptr, name, datatype, buffer, indep);
write_data(group_id, ndim, dims, name, datatype, buffer, indep);
// Free resources
H5Tclose(datatype);
@ -292,7 +292,7 @@ write_string(hid_t group_id, char const* name, const char* buffer, bool indep)
void
write_string(hid_t group_id, char const* name, const std::string& buffer, bool indep)
{
write_string(group_id, name, buffer.c_str(), indep);
write_string(group_id, 0, nullptr, buffer.length(), name, buffer.c_str(), indep);
}
}

View file

@ -59,8 +59,9 @@ extern "C" void write_int(hid_t group_id, int ndim, const hsize_t* dims,
extern "C" void write_llong(hid_t group_id, int ndim, const hsize_t* dims,
const char* name, const long long* buffer, bool indep);
extern "C" void write_string(hid_t group_id, char const *name, char const *buffer, bool indep);
void write_string(hid_t group_id, char const *name, const std::string &buffer, bool indep);
extern "C" void write_string(hid_t group_id, int ndim, const hsize_t* dims, size_t slen,
const char* name, char const* buffer, bool indep);
void write_string(hid_t group_id, const char* name, const std::string& buffer, bool indep);
} // namespace openmc
#endif //HDF5_INTERFACE_H