read:dataset: character 0d..7d

Author: scivision

src/read_char.inc

@@ -0,0 +1,19 @@
+integer(HID_T) :: type_id
+integer :: ier, charlen, obj_type
+logical :: is_vlen
+
+!> variable length string
+integer(HSIZE_T) :: dims(rank(A)), Npts, dsize
+
+charlen = len(A)
+
+call open_char(self, obj_name, obj_id, file_space_id, charlen, obj_type, type_id, dims, Npts, dsize, is_vlen)
+
+if(is_vlen) then
+  call read_vlen(self, obj_name, obj_type, obj_id, type_id, dsize, A, mem_space_id, file_space_id)
+else
+  call read_fixed(self, obj_name, obj_type, obj_id, type_id, dsize, A, mem_space_id, file_space_id)
+endif
+
+call H5Tclose_f(type_id, ier)
+if(ier/=0) error stop "ERROR:h5fortran:read:H5Tclose " // obj_name

src/read_fixed.inc

@@ -0,0 +1,20 @@
+class(hdf5_file), intent(in) :: self
+character(*), intent(in) :: obj_name
+integer, intent(in) :: obj_type
+integer(HID_T), intent(in) :: obj_id, type_id, mem_space_id, file_space_id
+
+TYPE(C_PTR) :: f_ptr
+
+integer :: ier
+
+allocate(buf, mold=A)
+f_ptr = C_LOC(buf)
+
+if(obj_type == H5I_DATASET_F) then
+  call H5Dread_f(obj_id, type_id, f_ptr, ier, mem_space_id, file_space_id)
+elseif(obj_type == H5I_ATTR_F) then
+  call H5Aread_f(obj_id, type_id, f_ptr, ier)
+endif
+if(ier/=0) error stop "ERROR:h5fortran:read_ascii: read " // obj_name // " " // self%filename
+
+A = pad_trim(buf)

src/read_vlen.inc

@@ -0,0 +1,32 @@
+class(hdf5_file), intent(in) :: self
+character(*), intent(in) :: obj_name
+integer, intent(in) :: obj_type
+integer(HID_T), intent(in) :: obj_id, type_id, mem_space_id, file_space_id
+integer(HSIZE_T), intent(in) :: dsize
+
+TYPE(C_PTR), DIMENSION(:), ALLOCATABLE, TARGET :: cbuf
+character(dsize), dimension(:), allocatable :: buf
+CHARACTER(dsize, kind=C_CHAR), POINTER :: cstr
+TYPE(C_PTR) :: f_ptr
+
+integer :: ier, dims(rank(A))
+integer(HSIZE_T) :: i
+
+dims = shape(A)
+
+allocate(cbuf(product(dims)), buf(product(dims)))
+f_ptr = C_LOC(cbuf)
+
+if(obj_type == H5I_DATASET_F) then
+  call H5Dread_f(obj_id, type_id, f_ptr, ier, mem_space_id, file_space_id)
+elseif(obj_type == H5I_ATTR_F) then
+  call H5Aread_f(obj_id, type_id, f_ptr, ier)
+endif
+if(ier/=0) error stop "h5fortran:read:read_ascii: read " // obj_name // " " // self%filename
+
+do i = 1, size(cbuf)
+  call C_F_POINTER(cbuf(i), cstr)
+  buf(i) = pad_trim(cstr)
+enddo
+
+A = reshape(buf, dims)