From c31d6232267dd5811c88e2feb05e3806b83bdd11 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 13 May 2016 08:44:21 -0500 Subject: [PATCH 1/2] Ability to read from attributes on HDF5 groups/datasets --- src/hdf5_interface.F90 | 918 ++++++++++++++++++++++++++++----------- src/initialize.F90 | 4 +- src/particle_restart.F90 | 30 +- src/source.F90 | 2 +- src/state_point.F90 | 72 +-- 5 files changed, 712 insertions(+), 314 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 01e50d983..ce934baa4 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -64,14 +64,28 @@ module hdf5_interface module procedure read_tally_result_2D end interface read_dataset + interface read_attribute + module procedure read_attribute_double + module procedure read_attribute_double_1D + module procedure read_attribute_double_2D + module procedure read_attribute_integer + module procedure read_attribute_integer_1D + module procedure read_attribute_integer_2D + module procedure read_attribute_string + end interface read_attribute + public :: write_dataset public :: read_dataset + public :: read_attribute public :: file_create public :: file_open public :: file_close public :: create_group public :: open_group public :: close_group + public :: open_dataset + public :: close_dataset + public :: get_shape public :: write_attribute_string contains @@ -243,6 +257,44 @@ contains end if end subroutine close_group +!=============================================================================== +! OPEN_DATASET opens an existing HDF5 dataset +!=============================================================================== + + function open_dataset(group_id, name) result(dataset_id) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of dataset + integer(HID_T) :: dataset_id + + logical :: exists ! does the dataset exist + integer :: hdf5_err ! HDF5 error code + + ! Check if group exists + call h5ltpath_valid_f(group_id, trim(name), .true., exists, hdf5_err) + + ! open group if it exists + if (exists) then + call h5dopen_f(group_id, trim(name), dataset_id, hdf5_err) + else + call fatal_error("The dataset '" // trim(name) // "' does not exist.") + end if + end function open_dataset + +!=============================================================================== +! CLOSE_GROUP closes HDF5 temp_group +!=============================================================================== + + subroutine close_dataset(dataset_id) + integer(HID_T), intent(inout) :: dataset_id + + integer :: hdf5_err ! HDF5 error code + + call h5dclose_f(dataset_id, hdf5_err) + if (hdf5_err < 0) then + call fatal_error("Unable to close HDF5 dataset.") + end if + end subroutine close_dataset + !=============================================================================== ! WRITE_DOUBLE writes double precision scalar data !=============================================================================== @@ -293,19 +345,27 @@ contains ! READ_DOUBLE reads double precision scalar data !=============================================================================== - subroutine read_double(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name ! name for data - real(8), intent(inout), target :: buffer ! read data to here - logical, intent(in), optional :: indep ! independent I/O + subroutine read_double(buffer, obj_id, name, indep) + real(8), target, intent(inout) :: buffer + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: indep ! independent I/O - integer :: hdf5_err - integer :: data_xfer_mode + integer :: hdf5_err + integer :: data_xfer_mode #ifdef PHDF5 integer(HID_T) :: plist ! property list #endif - integer(HID_T) :: dset ! data set handle - type(c_ptr) :: f_ptr + integer(HID_T) :: dset_id + type(c_ptr) :: f_ptr + + ! If 'name' argument is passed, obj_id is interpreted to be a group and + ! 'name' is the name of the dataset we should read from + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) + else + dset_id = obj_id + end if ! Set up collective vs. independent I/O data_xfer_mode = H5FD_MPIO_COLLECTIVE_F @@ -313,21 +373,20 @@ contains if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F end if - call h5dopen_f(group_id, trim(name), dset, hdf5_err) f_ptr = c_loc(buffer) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) end if - call h5dclose_f(dset, hdf5_err) + if (present(name)) call h5dclose_f(dset_id, hdf5_err) end subroutine read_double !=============================================================================== @@ -396,35 +455,46 @@ contains ! READ_DOUBLE_1D reads double precision 1-D array data !=============================================================================== - subroutine read_double_1D(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name ! name of data - real(8), intent(inout), target :: buffer(:) ! data to write - logical, intent(in), optional :: indep ! independent I/O + subroutine read_double_1D(buffer, obj_id, name, indep) + real(8), target, intent(inout) :: buffer(:) + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: indep ! independent I/O + integer :: hdf5_err + integer(HID_T) :: dset_id integer(HSIZE_T) :: dims(1) - dims(:) = shape(buffer) - if (present(indep)) then - call read_double_1D_explicit(group_id, dims, name, buffer, indep) + ! If 'name' argument is passed, obj_id is interpreted to be a group and + ! 'name' is the name of the dataset we should read from + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) else - call read_double_1D_explicit(group_id, dims, name, buffer) + dset_id = obj_id end if + + dims(:) = shape(buffer) + + if (present(indep)) then + call read_double_1D_explicit(dset_id, dims, buffer, indep) + else + call read_double_1D_explicit(dset_id, dims, buffer) + end if + + if (present(name)) call h5dclose_f(dset_id, hdf5_err) end subroutine read_double_1D - subroutine read_double_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 ! name of data - real(8), intent(inout), target :: buffer(dims(1)) ! data to write - logical, intent(in), optional :: indep ! independent I/O + subroutine read_double_1D_explicit(dset_id, dims, buffer, indep) + integer(HID_T), intent(in) :: dset_id + integer(HSIZE_T), intent(in) :: dims(1) + real(8), target, intent(inout) :: buffer(dims(1)) + logical, optional, intent(in) :: 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 type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -433,21 +503,18 @@ contains if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F end if - call h5dopen_f(group_id, trim(name), dset, hdf5_err) f_ptr = c_loc(buffer) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) end if - - call h5dclose_f(dset, hdf5_err) end subroutine read_double_1D_explicit !=============================================================================== @@ -516,35 +583,46 @@ contains ! READ_DOUBLE_2D reads double precision 2-D array data !=============================================================================== - subroutine read_double_2D(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name ! name of data - real(8), intent(inout), target :: buffer(:,:) ! data to write - logical, intent(in), optional :: indep ! independent I/O + subroutine read_double_2D(buffer, obj_id, name, indep) + real(8), target, intent(inout) :: buffer(:,:) + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: indep ! independent I/O + integer :: hdf5_err + integer(HID_T) :: dset_id integer(HSIZE_T) :: dims(2) - dims(:) = shape(buffer) - if (present(indep)) then - call read_double_2D_explicit(group_id, dims, name, buffer, indep) + ! If 'name' argument is passed, obj_id is interpreted to be a group and + ! 'name' is the name of the dataset we should read from + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) else - call read_double_2D_explicit(group_id, dims, name, buffer) + dset_id = obj_id end if + + dims(:) = shape(buffer) + + if (present(indep)) then + call read_double_2D_explicit(dset_id, dims, buffer, indep) + else + call read_double_2D_explicit(dset_id, dims, buffer) + end if + + if (present(name)) call h5dclose_f(dset_id, hdf5_err) end subroutine read_double_2D - subroutine read_double_2D_explicit(group_id, dims, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - integer(HSIZE_T), intent(in) :: dims(2) - character(*), intent(in) :: name ! name of data - real(8), intent(inout), target :: buffer(dims(1),dims(2)) - logical, intent(in), optional :: indep ! independent I/O + subroutine read_double_2D_explicit(dset_id, dims, buffer, indep) + integer(HID_T), intent(in) :: dset_id + integer(HSIZE_T), intent(in) :: dims(2) + real(8), target, intent(inout) :: buffer(dims(1),dims(2)) + logical, optional, intent(in) :: 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 type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -553,21 +631,18 @@ contains if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F end if - call h5dopen_f(group_id, trim(name), dset, hdf5_err) f_ptr = c_loc(buffer) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) end if - - call h5dclose_f(dset, hdf5_err) end subroutine read_double_2D_explicit !=============================================================================== @@ -636,35 +711,46 @@ contains ! READ_DOUBLE_3D reads double precision 3-D array data !=============================================================================== - subroutine read_double_3D(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name ! name of data - real(8), intent(inout), target :: buffer(:,:,:) ! data to write - logical, intent(in), optional :: indep ! independent I/O + subroutine read_double_3D(buffer, obj_id, name, indep) + real(8), target, intent(inout) :: buffer(:,:,:) + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: indep ! independent I/O + integer :: hdf5_err + integer(HID_T) :: dset_id integer(HSIZE_T) :: dims(3) - dims(:) = shape(buffer) - if (present(indep)) then - call read_double_3D_explicit(group_id, dims, name, buffer, indep) + ! If 'name' argument is passed, obj_id is interpreted to be a group and + ! 'name' is the name of the dataset we should read from + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) else - call read_double_3D_explicit(group_id, dims, name, buffer) + dset_id = obj_id end if + + dims(:) = shape(buffer) + + if (present(indep)) then + call read_double_3D_explicit(dset_id, dims, buffer, indep) + else + call read_double_3D_explicit(dset_id, dims, buffer) + end if + + if (present(name)) call h5dclose_f(dset_id, hdf5_err) end subroutine read_double_3D - subroutine read_double_3D_explicit(group_id, dims, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - integer(HSIZE_T), intent(in) :: dims(3) - character(*), intent(in) :: name ! name of data - real(8), intent(inout), target :: buffer(dims(1),dims(2),dims(3)) - logical, intent(in), optional :: indep ! independent I/O + subroutine read_double_3D_explicit(dset_id, dims, buffer, indep) + integer(HID_T), intent(in) :: dset_id + integer(HSIZE_T), intent(in) :: dims(3) + real(8), target, intent(inout) :: buffer(dims(1),dims(2),dims(3)) + logical, optional, intent(in) :: 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 type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -673,21 +759,18 @@ contains if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F end if - call h5dopen_f(group_id, trim(name), dset, hdf5_err) f_ptr = c_loc(buffer) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) end if - - call h5dclose_f(dset, hdf5_err) end subroutine read_double_3D_explicit !=============================================================================== @@ -756,35 +839,46 @@ contains ! READ_DOUBLE_4D reads double precision 4-D array data !=============================================================================== - subroutine read_double_4D(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name ! name of data - real(8), intent(inout), target :: buffer(:,:,:,:) ! data to write - logical, intent(in), optional :: indep ! independent I/O + subroutine read_double_4D(buffer, obj_id, name, indep) + real(8), target, intent(inout) :: buffer(:,:,:,:) + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: indep ! independent I/O + integer :: hdf5_err + integer(HID_T) :: dset_id integer(HSIZE_T) :: dims(4) - dims(:) = shape(buffer) - if (present(indep)) then - call read_double_4D_explicit(group_id, dims, name, buffer, indep) + ! If 'name' argument is passed, obj_id is interpreted to be a group and + ! 'name' is the name of the dataset we should read from + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) else - call read_double_4D_explicit(group_id, dims, name, buffer) + dset_id = obj_id end if + + dims(:) = shape(buffer) + + if (present(indep)) then + call read_double_4D_explicit(dset_id, dims, buffer, indep) + else + call read_double_4D_explicit(dset_id, dims, buffer) + end if + + if (present(name)) call h5dclose_f(dset_id, hdf5_err) end subroutine read_double_4D - subroutine read_double_4D_explicit(group_id, dims, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - integer(HSIZE_T), intent(in) :: dims(4) - character(*), intent(in) :: name ! name of data - real(8), intent(inout), target :: buffer(dims(1),dims(2),dims(3),dims(4)) - logical, intent(in), optional :: indep ! independent I/O + subroutine read_double_4D_explicit(dset_id, dims, buffer, indep) + integer(HID_T), intent(in) :: dset_id + integer(HSIZE_T), intent(in) :: dims(4) + real(8), target, intent(inout) :: buffer(dims(1),dims(2),dims(3),dims(4)) + logical, optional, intent(in) :: 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 type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -793,21 +887,18 @@ contains if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F end if - call h5dopen_f(group_id, trim(name), dset, hdf5_err) f_ptr = c_loc(buffer) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) end if - - call h5dclose_f(dset, hdf5_err) end subroutine read_double_4D_explicit !=============================================================================== @@ -860,19 +951,27 @@ contains ! READ_INTEGER reads integer precision scalar data !=============================================================================== - subroutine read_integer(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name ! name for data - integer, intent(inout), target :: buffer ! read data to here - logical, intent(in), optional :: indep ! independent I/O + subroutine read_integer(buffer, obj_id, name, indep) + integer, target, intent(inout) :: buffer + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: indep ! independent I/O - integer :: hdf5_err - integer :: data_xfer_mode + integer :: hdf5_err + integer :: data_xfer_mode #ifdef PHDF5 integer(HID_T) :: plist ! property list #endif - integer(HID_T) :: dset ! data set handle - type(c_ptr) :: f_ptr + integer(HID_T) :: dset_id + type(c_ptr) :: f_ptr + + ! If 'name' argument is passed, obj_id is interpreted to be a group and + ! 'name' is the name of the dataset we should read from + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) + else + dset_id = obj_id + end if ! Set up collective vs. independent I/O data_xfer_mode = H5FD_MPIO_COLLECTIVE_F @@ -880,21 +979,20 @@ contains if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F end if - call h5dopen_f(group_id, trim(name), dset, hdf5_err) f_ptr = c_loc(buffer) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5dread_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + call h5dread_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) end if - call h5dclose_f(dset, hdf5_err) + if (present(name)) call h5dclose_f(dset_id, hdf5_err) end subroutine read_integer !=============================================================================== @@ -963,35 +1061,46 @@ contains ! READ_INTEGER_1D reads integer precision 1-D array data !=============================================================================== - subroutine read_integer_1D(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name ! name of data - integer, intent(inout), target :: buffer(:) ! data to write - logical, intent(in), optional :: indep ! independent I/O + subroutine read_integer_1D(buffer, obj_id, name, indep) + integer, target, intent(inout) :: buffer(:) + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: indep ! independent I/O + integer :: hdf5_err + integer(HID_T) :: dset_id integer(HSIZE_T) :: dims(1) - dims(:) = shape(buffer) - if (present(indep)) then - call read_integer_1D_explicit(group_id, dims, name, buffer, indep) + ! If 'name' argument is passed, obj_id is interpreted to be a group and + ! 'name' is the name of the dataset we should read from + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) else - call read_integer_1D_explicit(group_id, dims, name, buffer) + dset_id = obj_id end if + + dims(:) = shape(buffer) + + if (present(indep)) then + call read_integer_1D_explicit(dset_id, dims, buffer, indep) + else + call read_integer_1D_explicit(dset_id, dims, buffer) + end if + + if (present(name)) call h5dclose_f(dset_id, hdf5_err) end subroutine read_integer_1D - subroutine read_integer_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 ! name of data - integer, intent(inout), target :: buffer(dims(1)) ! data to write - logical, intent(in), optional :: indep ! independent I/O + subroutine read_integer_1D_explicit(dset_id, dims, buffer, indep) + integer(HID_T), intent(in) :: dset_id + integer(HSIZE_T), intent(in) :: dims(1) + integer, target, intent(inout) :: buffer(dims(1)) + logical, optional, intent(in) :: 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 type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -1000,21 +1109,18 @@ contains if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F end if - call h5dopen_f(group_id, trim(name), dset, hdf5_err) f_ptr = c_loc(buffer) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5dread_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + call h5dread_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) end if - - call h5dclose_f(dset, hdf5_err) end subroutine read_integer_1D_explicit !=============================================================================== @@ -1083,35 +1189,46 @@ contains ! READ_INTEGER_2D reads integer precision 2-D array data !=============================================================================== - subroutine read_integer_2D(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name ! name of data - integer, intent(inout), target :: buffer(:,:) ! data to write - logical, intent(in), optional :: indep ! independent I/O + subroutine read_integer_2D(buffer, obj_id, name, indep) + integer, target, intent(inout) :: buffer(:,:) + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: indep ! independent I/O + integer :: hdf5_err + integer(HID_T) :: dset_id integer(HSIZE_T) :: dims(2) - dims(:) = shape(buffer) - if (present(indep)) then - call read_integer_2D_explicit(group_id, dims, name, buffer, indep) + ! If 'name' argument is passed, obj_id is interpreted to be a group and + ! 'name' is the name of the dataset we should read from + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) else - call read_integer_2D_explicit(group_id, dims, name, buffer) + dset_id = obj_id end if + + dims(:) = shape(buffer) + + if (present(indep)) then + call read_integer_2D_explicit(dset_id, dims, buffer, indep) + else + call read_integer_2D_explicit(dset_id, dims, buffer) + end if + + if (present(name)) call h5dclose_f(dset_id, hdf5_err) end subroutine read_integer_2D - subroutine read_integer_2D_explicit(group_id, dims, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - integer(HSIZE_T), intent(in) :: dims(2) - character(*), intent(in) :: name ! name of data - integer, intent(inout), target :: buffer(dims(1),dims(2)) - logical, intent(in), optional :: indep ! independent I/O + subroutine read_integer_2D_explicit(dset_id, dims, buffer, indep) + integer(HID_T), intent(in) :: dset_id + integer(HSIZE_T), intent(in) :: dims(2) + integer, target, intent(inout) :: buffer(dims(1),dims(2)) + logical, optional, intent(in) :: 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 type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -1120,21 +1237,18 @@ contains if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F end if - call h5dopen_f(group_id, trim(name), dset, hdf5_err) f_ptr = c_loc(buffer) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5dread_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + call h5dread_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) end if - - call h5dclose_f(dset, hdf5_err) end subroutine read_integer_2D_explicit !=============================================================================== @@ -1203,35 +1317,46 @@ contains ! READ_INTEGER_3D reads integer precision 3-D array data !=============================================================================== - subroutine read_integer_3D(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name ! name of data - integer, intent(inout), target :: buffer(:,:,:) ! data to write - logical, intent(in), optional :: indep ! independent I/O + subroutine read_integer_3D(buffer, obj_id, name, indep) + integer, target, intent(inout) :: buffer(:,:,:) + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: indep ! independent I/O + integer :: hdf5_err + integer(HID_T) :: dset_id integer(HSIZE_T) :: dims(3) - dims(:) = shape(buffer) - if (present(indep)) then - call read_integer_3D_explicit(group_id, dims, name, buffer, indep) + ! If 'name' argument is passed, obj_id is interpreted to be a group and + ! 'name' is the name of the dataset we should read from + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) else - call read_integer_3D_explicit(group_id, dims, name, buffer) + dset_id = obj_id end if + + dims(:) = shape(buffer) + + if (present(indep)) then + call read_integer_3D_explicit(dset_id, dims, buffer, indep) + else + call read_integer_3D_explicit(dset_id, dims, buffer) + end if + + if (present(name)) call h5dclose_f(dset_id, hdf5_err) end subroutine read_integer_3D - subroutine read_integer_3D_explicit(group_id, dims, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - integer(HSIZE_T), intent(in) :: dims(3) - character(*), intent(in) :: name ! name of data - integer, intent(inout), target :: buffer(dims(1),dims(2),dims(3)) - logical, intent(in), optional :: indep ! independent I/O + subroutine read_integer_3D_explicit(dset_id, dims, buffer, indep) + integer(HID_T), intent(in) :: dset_id + integer(HSIZE_T), intent(in) :: dims(3) + integer, target, intent(inout) :: buffer(dims(1),dims(2),dims(3)) + logical, optional, intent(in) :: 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 type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -1240,21 +1365,18 @@ contains if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F end if - call h5dopen_f(group_id, trim(name), dset, hdf5_err) f_ptr = c_loc(buffer) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5dread_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + call h5dread_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) end if - - call h5dclose_f(dset, hdf5_err) end subroutine read_integer_3D_explicit !=============================================================================== @@ -1323,35 +1445,46 @@ contains ! READ_INTEGER_4D reads integer precision 4-D array data !=============================================================================== - subroutine read_integer_4D(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name ! name of data - integer, intent(inout), target :: buffer(:,:,:,:) ! data to write - logical, intent(in), optional :: indep ! independent I/O + subroutine read_integer_4D(buffer, obj_id, name, indep) + integer, target, intent(inout) :: buffer(:,:,:,:) + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: indep ! independent I/O + integer :: hdf5_err + integer(HID_T) :: dset_id integer(HSIZE_T) :: dims(4) - dims(:) = shape(buffer) - if (present(indep)) then - call read_integer_4D_explicit(group_id, dims, name, buffer, indep) + ! If 'name' argument is passed, obj_id is interpreted to be a group and + ! 'name' is the name of the dataset we should read from + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) else - call read_integer_4D_explicit(group_id, dims, name, buffer) + dset_id = obj_id end if + + dims(:) = shape(buffer) + + if (present(indep)) then + call read_integer_4D_explicit(dset_id, dims, buffer, indep) + else + call read_integer_4D_explicit(dset_id, dims, buffer) + end if + + if (present(name)) call h5dclose_f(dset_id, hdf5_err) end subroutine read_integer_4D - subroutine read_integer_4D_explicit(group_id, dims, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - integer(HSIZE_T), intent(in) :: dims(4) - character(*), intent(in) :: name ! name of data - integer, intent(inout), target :: buffer(dims(1),dims(2),dims(3),dims(4)) - logical, intent(in), optional :: indep ! independent I/O + subroutine read_integer_4D_explicit(dset_id, dims, buffer, indep) + integer(HID_T), intent(in) :: dset_id + integer(HSIZE_T), intent(in) :: dims(4) + integer, target, intent(inout) :: buffer(dims(1),dims(2),dims(3),dims(4)) + logical, optional, intent(in) :: 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 type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -1360,21 +1493,18 @@ contains if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F end if - call h5dopen_f(group_id, trim(name), dset, hdf5_err) f_ptr = c_loc(buffer) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5dread_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + call h5dread_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) end if - - call h5dclose_f(dset, hdf5_err) end subroutine read_integer_4D_explicit !=============================================================================== @@ -1427,19 +1557,27 @@ contains ! READ_LONG reads long integer scalar data !=============================================================================== - subroutine read_long(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name ! name for data - integer(8), intent(inout), target :: buffer ! read data to here - logical, intent(in), optional :: indep ! independent I/O + subroutine read_long(buffer, obj_id, name, indep) + integer(8), target, intent(inout) :: buffer + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: indep ! independent I/O - integer :: hdf5_err - integer :: data_xfer_mode + integer :: hdf5_err + integer :: data_xfer_mode #ifdef PHDF5 integer(HID_T) :: plist ! property list #endif - integer(HID_T) :: dset ! data set handle - type(c_ptr) :: f_ptr + integer(HID_T) :: dset_id + type(c_ptr) :: f_ptr + + ! If 'name' argument is passed, obj_id is interpreted to be a group and + ! 'name' is the name of the dataset we should read from + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) + else + dset_id = obj_id + end if ! Set up collective vs. independent I/O data_xfer_mode = H5FD_MPIO_COLLECTIVE_F @@ -1447,21 +1585,20 @@ contains if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F end if - call h5dopen_f(group_id, trim(name), dset, hdf5_err) f_ptr = c_loc(buffer) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, hdf5_integer8_t, f_ptr, hdf5_err, xfer_prp=plist) + call h5dread_f(dset_id, hdf5_integer8_t, f_ptr, hdf5_err, xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, hdf5_integer8_t, f_ptr, hdf5_err) + call h5dread_f(dset_id, hdf5_integer8_t, f_ptr, hdf5_err) end if - call h5dclose_f(dset, hdf5_err) + if (present(name)) call h5dclose_f(dset_id, hdf5_err) end subroutine read_long !=============================================================================== @@ -1529,37 +1666,42 @@ contains ! READ_STRING reads string data !=============================================================================== - subroutine read_string(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name ! name for data - character(*), intent(inout), target :: buffer ! read data to here - logical, intent(in), optional :: indep ! independent I/O + subroutine read_string(buffer, obj_id, name, indep) + character(*), target, intent(inout) :: buffer + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: 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) :: dset_id + integer(HID_T) :: space_id integer(HID_T) :: filetype integer(HID_T) :: memtype integer(SIZE_T) :: size integer(SIZE_T) :: n type(c_ptr) :: f_ptr + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) + else + dset_id = obj_id + end if + ! 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 - ! Get dataset and dataspace - call h5dopen_f(group_id, trim(name), dset, hdf5_err) - call h5dget_space_f(dset, dspace, hdf5_err) + ! Get dataspace + call h5dget_space_f(dset_id, space_id, hdf5_err) ! Make sure buffer is large enough - call h5dget_type_f(dset, filetype, hdf5_err) + call h5dget_type_f(dset_id, filetype, hdf5_err) call h5tget_size_f(filetype, size, hdf5_err) if (size > len(buffer) + 1) then call fatal_error("Character buffer is not long enough to & @@ -1574,20 +1716,21 @@ contains ! Get pointer to start of string f_ptr = c_loc(buffer(1:1)) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, memtype, f_ptr, hdf5_err, mem_space_id=dspace, & - xfer_prp=plist) + call h5dread_f(dset_id, memtype, f_ptr, hdf5_err, & + mem_space_id=space_id, xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, memtype, f_ptr, hdf5_err, mem_space_id=dspace) + call h5dread_f(dset_id, memtype, f_ptr, hdf5_err, mem_space_id=space_id) end if - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) + if (present(name)) call h5dclose_f(dset_id, hdf5_err) + + call h5sclose_f(space_id, hdf5_err) call h5tclose_f(filetype, hdf5_err) call h5tclose_f(memtype, hdf5_err) end subroutine read_string @@ -1674,36 +1817,45 @@ contains ! READ_STRING_1D reads string 1-D array data !=============================================================================== - subroutine read_string_1D(group_id, name, buffer, indep) - integer(HID_T), intent(in) :: group_id - character(*), intent(in) :: name - character(*), intent(inout), target :: buffer(:) - logical, intent(in), optional :: indep ! independent I/O + subroutine read_string_1D(buffer, obj_id, name, indep) + character(*), target, intent(inout) :: buffer(:) + integer(HID_T), intent(in) :: obj_id + character(*), optional, intent(in) :: name + logical, optional, intent(in) :: indep ! independent I/O + integer :: hdf5_err + integer(HID_T) :: dset_id integer(HSIZE_T) :: dims(1) - dims(:) = shape(buffer) - if (present(indep)) then - call read_string_1D_explicit(group_id, dims, name, buffer, indep) + ! If 'name' argument is passed, obj_id is interpreted to be a group and + ! 'name' is the name of the dataset we should read from + if (present(name)) then + call h5dopen_f(obj_id, trim(name), dset_id, hdf5_err) else - call read_string_1D_explicit(group_id, dims, name, buffer) + dset_id = obj_id + end if + + dims(:) = shape(buffer) + + if (present(indep)) then + call read_string_1D_explicit(dset_id, dims, buffer, indep) + else + call read_string_1D_explicit(dset_id, dims, buffer) end if end subroutine read_string_1D - subroutine read_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(inout), target :: buffer(dims(1)) - logical, intent(in), optional :: indep ! independent I/O + subroutine read_string_1D_explicit(dset_id, dims, buffer, indep) + integer(HID_T), intent(in) :: dset_id + integer(HSIZE_T), intent(in) :: dims(1) + character(*), target, intent(inout) :: buffer(dims(1)) + logical, optional, intent(in) :: 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) :: space_id integer(HID_T) :: filetype integer(HID_T) :: memtype integer(SIZE_T) :: size @@ -1717,11 +1869,10 @@ contains end if ! Get dataset and dataspace - call h5dopen_f(group_id, trim(name), dset, hdf5_err) - call h5dget_space_f(dset, dspace, hdf5_err) + call h5dget_space_f(dset_id, space_id, hdf5_err) ! Make sure buffer is large enough - call h5dget_type_f(dset, filetype, hdf5_err) + call h5dget_type_f(dset_id, filetype, hdf5_err) call h5tget_size_f(filetype, size, hdf5_err) if (size > len(buffer(1)) + 1) then call fatal_error("Character buffer is not long enough to & @@ -1736,20 +1887,19 @@ contains ! Get pointer to start of string f_ptr = c_loc(buffer(1)(1:1)) - if (using_mpio_device(group_id)) then + if (using_mpio_device(dset_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) - call h5dread_f(dset, memtype, f_ptr, hdf5_err, mem_space_id=dspace, & + call h5dread_f(dset_id, memtype, f_ptr, hdf5_err, mem_space_id=space_id, & xfer_prp=plist) call h5pclose_f(plist, hdf5_err) #endif else - call h5dread_f(dset, memtype, f_ptr, hdf5_err, mem_space_id=dspace) + call h5dread_f(dset_id, memtype, f_ptr, hdf5_err, mem_space_id=space_id) end if - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) + call h5sclose_f(space_id, hdf5_err) call h5tclose_f(filetype, hdf5_err) call h5tclose_f(memtype, hdf5_err) end subroutine read_string_1D_explicit @@ -1893,6 +2043,254 @@ contains call h5dclose_f(dset, hdf5_err) end subroutine read_tally_result_2D_explicit + subroutine read_attribute_double(buffer, obj_id, name) + real(8), intent(inout), target :: buffer + integer(HID_T), intent(in) :: obj_id + character(*), intent(in) :: name + + integer :: hdf5_err + integer(HID_T) :: attr_id + type(c_ptr) :: f_ptr + + call h5aopen_f(obj_id, trim(name), attr_id, hdf5_err) + f_ptr = c_loc(buffer) + call h5aread_f(attr_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + call h5aclose_f(attr_id, hdf5_err) + end subroutine read_attribute_double + + subroutine read_attribute_double_1D(buffer, obj_id, name) + real(8), target, allocatable, intent(inout) :: buffer(:) + integer(HID_T), intent(in) :: obj_id + character(*), intent(in) :: name + + integer :: hdf5_err + integer(HID_T) :: space_id + integer(HID_T) :: attr_id + integer(HSIZE_T) :: dims(1) + integer(HSIZE_T) :: maxdims(1) + + call h5aopen_f(obj_id, trim(name), attr_id, hdf5_err) + + if (allocated(buffer)) then + dims(:) = shape(buffer) + else + call h5aget_space_f(attr_id, space_id, hdf5_err) + call h5sget_simple_extent_dims_f(space_id, dims, maxdims, hdf5_err) + allocate(buffer(dims(1))) + call h5sclose_f(space_id, hdf5_err) + end if + + call read_attribute_double_1D_explicit(attr_id, dims, buffer) + call h5aclose_f(attr_id, hdf5_err) + end subroutine read_attribute_double_1D + + subroutine read_attribute_double_1D_explicit(attr_id, dims, buffer) + integer(HID_T), intent(in) :: attr_id + integer(HSIZE_T), intent(in) :: dims(1) + real(8), target, intent(inout) :: buffer(dims(1)) + + integer :: hdf5_err + type(c_ptr) :: f_ptr + + f_ptr = c_loc(buffer) + call h5aread_f(attr_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + end subroutine read_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 + character(*), intent(in) :: name + + integer :: hdf5_err + integer(HID_T) :: space_id + integer(HID_T) :: attr_id + integer(HSIZE_T) :: dims(2) + integer(HSIZE_T) :: maxdims(2) + + call h5aopen_f(obj_id, trim(name), attr_id, hdf5_err) + + if (allocated(buffer)) then + dims(:) = shape(buffer) + else + call h5aget_space_f(attr_id, space_id, hdf5_err) + call h5sget_simple_extent_dims_f(space_id, dims, maxdims, hdf5_err) + allocate(buffer(dims(1), dims(2))) + call h5sclose_f(space_id, hdf5_err) + end if + + call read_attribute_double_2D_explicit(attr_id, dims, buffer) + call h5aclose_f(attr_id, hdf5_err) + end subroutine read_attribute_double_2D + + subroutine read_attribute_double_2D_explicit(attr_id, dims, buffer) + integer(HID_T), intent(in) :: attr_id + integer(HSIZE_T), intent(in) :: dims(2) + real(8), target, intent(inout) :: buffer(dims(1),dims(2)) + + integer :: hdf5_err + type(c_ptr) :: f_ptr + + f_ptr = c_loc(buffer) + call h5aread_f(attr_id, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + end subroutine read_attribute_double_2D_explicit + + subroutine read_attribute_integer(buffer, obj_id, name) + integer, intent(inout), target :: buffer + integer(HID_T), intent(in) :: obj_id + character(*), intent(in) :: name + + integer :: hdf5_err + integer(HID_T) :: attr_id + type(c_ptr) :: f_ptr + + call h5aopen_f(obj_id, trim(name), attr_id, hdf5_err) + f_ptr = c_loc(buffer) + call h5aread_f(attr_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + call h5aclose_f(attr_id, hdf5_err) + end subroutine read_attribute_integer + + subroutine read_attribute_integer_1D(buffer, obj_id, name) + integer, target, allocatable, intent(inout) :: buffer(:) + integer(HID_T), intent(in) :: obj_id + character(*), intent(in) :: name + + integer :: hdf5_err + integer(HID_T) :: space_id + integer(HID_T) :: attr_id + integer(HSIZE_T) :: dims(1) + integer(HSIZE_T) :: maxdims(1) + + call h5aopen_f(obj_id, trim(name), attr_id, hdf5_err) + + if (allocated(buffer)) then + dims(:) = shape(buffer) + else + call h5aget_space_f(attr_id, space_id, hdf5_err) + call h5sget_simple_extent_dims_f(space_id, dims, maxdims, hdf5_err) + allocate(buffer(dims(1))) + call h5sclose_f(space_id, hdf5_err) + end if + + call read_attribute_integer_1D_explicit(attr_id, dims, buffer) + call h5aclose_f(attr_id, hdf5_err) + end subroutine read_attribute_integer_1D + + subroutine read_attribute_integer_1D_explicit(attr_id, dims, buffer) + integer(HID_T), intent(in) :: attr_id + integer(HSIZE_T), intent(in) :: dims(1) + integer, target, intent(inout) :: buffer(dims(1)) + + integer :: hdf5_err + type(c_ptr) :: f_ptr + + f_ptr = c_loc(buffer) + call h5aread_f(attr_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + end subroutine read_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 + character(*), intent(in) :: name + + integer :: hdf5_err + integer(HID_T) :: space_id + integer(HID_T) :: attr_id + integer(HSIZE_T) :: dims(2) + integer(HSIZE_T) :: maxdims(2) + + call h5aopen_f(obj_id, trim(name), attr_id, hdf5_err) + + if (allocated(buffer)) then + dims(:) = shape(buffer) + else + call h5aget_space_f(attr_id, space_id, hdf5_err) + call h5sget_simple_extent_dims_f(space_id, dims, maxdims, hdf5_err) + allocate(buffer(dims(1), dims(2))) + call h5sclose_f(space_id, hdf5_err) + end if + + call read_attribute_integer_2D_explicit(attr_id, dims, buffer) + call h5aclose_f(attr_id, hdf5_err) + end subroutine read_attribute_integer_2D + + subroutine read_attribute_integer_2D_explicit(attr_id, dims, buffer) + integer(HID_T), intent(in) :: attr_id + integer(HSIZE_T), intent(in) :: dims(2) + integer, target, intent(inout) :: buffer(dims(1),dims(2)) + + integer :: hdf5_err + type(c_ptr) :: f_ptr + + f_ptr = c_loc(buffer) + call h5aread_f(attr_id, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + end subroutine read_attribute_integer_2D_explicit + + subroutine read_attribute_string(buffer, obj_id, name) + character(*), intent(inout), target :: buffer ! read data to here + integer(HID_T), intent(in) :: obj_id + character(*), intent(in) :: name ! name for data + + integer :: hdf5_err + integer(HID_T) :: attr_id ! data set handle + integer(HID_T) :: filetype + integer(HID_T) :: memtype + integer(SIZE_T) :: i + integer(SIZE_T) :: size + character(kind=C_CHAR), allocatable, target :: temp_buffer(:) + type(c_ptr) :: f_ptr + + ! Get dataset and dataspace + call h5aopen_f(obj_id, trim(name), attr_id, hdf5_err) + + ! Make sure buffer is large enough + call h5aget_type_f(attr_id, filetype, hdf5_err) + call h5tget_size_f(filetype, size, hdf5_err) + allocate(temp_buffer(size)) + if (size > len(buffer)) then + call fatal_error("Character buffer is not long enough to & + &read HDF5 string.") + end if + + ! Get datatype in memory based on Fortran character + call h5tcopy_f(H5T_C_S1, memtype, hdf5_err) + call h5tset_size_f(memtype, size + 1, hdf5_err) + + ! Get pointer to start of string + f_ptr = c_loc(temp_buffer(1)) + + call h5aread_f(attr_id, memtype, f_ptr, hdf5_err) + buffer = '' + do i = 1, size + buffer(i:i) = temp_buffer(i) + end do + deallocate(temp_buffer) + + call h5aclose_f(attr_id, hdf5_err) + call h5tclose_f(filetype, hdf5_err) + call h5tclose_f(memtype, hdf5_err) + end subroutine read_attribute_string + + subroutine get_shape(obj_id, dims) + integer(HID_T), intent(in) :: obj_id + integer(HSIZE_T), intent(out) :: dims(:) + + integer :: hdf5_err + integer :: type + integer(HID_T) :: space_id + integer(HSIZE_T) :: maxdims(size(dims)) + + call h5iget_type_f(obj_id, type, hdf5_err) + if (type == H5I_DATASET_F) then + call h5dget_space_f(obj_id, space_id, hdf5_err) + call h5sget_simple_extent_dims_f(space_id, dims, maxdims, hdf5_err) + call h5sclose_f(space_id, hdf5_err) + elseif (type == H5I_ATTR_F) then + call h5aget_space_f(obj_id, space_id, hdf5_err) + call h5sget_simple_extent_dims_f(space_id, dims, maxdims, hdf5_err) + call h5sclose_f(space_id, hdf5_err) + end if + end subroutine get_shape + function using_mpio_device(obj_id) result(mpio) integer(HID_T), intent(in) :: obj_id logical :: mpio diff --git a/src/initialize.F90 b/src/initialize.F90 index 09bedb138..8c4eabbc1 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -375,7 +375,7 @@ contains ! Check what type of file this is file_id = file_open(argv(i), 'r', parallel=.true.) - call read_dataset(file_id, 'filetype', filetype) + call read_dataset(filetype, file_id, 'filetype') call file_close(file_id) ! Set path and flag for type of run @@ -401,7 +401,7 @@ contains ! Check file type is a source file file_id = file_open(argv(i), 'r', parallel=.true.) - call read_dataset(file_id, 'filetype', filetype) + call read_dataset(filetype, file_id, 'filetype') call file_close(file_id) if (filetype /= 'source') then call fatal_error("Second file after restart flag must be a & diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index 9d49a4f97..4040a471a 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -71,7 +71,7 @@ contains integer :: int_scalar integer(HID_T) :: file_id - character(MAX_WORD_LEN) :: mode + character(MAX_WORD_LEN) :: tempstr ! Write meessage call write_message("Loading particle restart file " & @@ -81,25 +81,25 @@ contains file_id = file_open(path_particle_restart, 'r') ! Read data from file - call read_dataset(file_id, 'filetype', int_scalar) - call read_dataset(file_id, 'revision', int_scalar) - call read_dataset(file_id, 'current_batch', current_batch) - call read_dataset(file_id, 'gen_per_batch', gen_per_batch) - call read_dataset(file_id, 'current_gen', current_gen) - call read_dataset(file_id, 'n_particles', n_particles) - call read_dataset(file_id, 'run_mode', mode) - select case (mode) + call read_dataset(tempstr, file_id, 'filetype') + call read_dataset(int_scalar, file_id, 'revision') + call read_dataset(current_batch, file_id, 'current_batch') + call read_dataset(gen_per_batch, file_id, 'gen_per_batch') + call read_dataset(current_gen, file_id, 'current_gen') + call read_dataset(n_particles, file_id, 'n_particles') + call read_dataset(tempstr, file_id, 'run_mode') + select case (tempstr) case ('k-eigenvalue') previous_run_mode = MODE_EIGENVALUE case ('fixed source') previous_run_mode = MODE_FIXEDSOURCE end select - call read_dataset(file_id, 'id', p%id) - call read_dataset(file_id, 'weight', p%wgt) - call read_dataset(file_id, 'energy', p%E) - call read_dataset(file_id, 'energy_group', p%g) - call read_dataset(file_id, 'xyz', p%coord(1)%xyz) - call read_dataset(file_id, 'uvw', p%coord(1)%uvw) + call read_dataset(p%id, file_id, 'id') + call read_dataset(p%wgt, file_id, 'weight') + call read_dataset(p%E, file_id, 'energy') + call read_dataset(p%g, file_id, 'energy_group') + call read_dataset(p%coord(1)%xyz, file_id, 'xyz') + call read_dataset(p%coord(1)%uvw, file_id, 'uvw') ! Set particle last attributes p%last_wgt = p%wgt diff --git a/src/source.F90 b/src/source.F90 index ad565c95c..194c8c6ad 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -53,7 +53,7 @@ contains file_id = file_open(path_source, 'r', parallel=.true.) ! Read the file type - call read_dataset(file_id, "filetype", filetype) + call read_dataset(filetype, file_id, "filetype") ! Check to make sure this is a source file if (filetype /= 'source') then diff --git a/src/state_point.F90 b/src/state_point.F90 index cbd6c017a..81abf0c1b 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -703,25 +703,25 @@ contains file_id = file_open(path_state_point, 'r', parallel=.true.) ! Read filetype - call read_dataset(file_id, "filetype", word) + call read_dataset(word, file_id, "filetype") if (word /= 'statepoint') then call fatal_error("OpenMC tried to restart from a non-statepoint file.") end if ! Read revision number for state point file and make sure it matches with ! current version - call read_dataset(file_id, "revision", int_array(1)) + call read_dataset(int_array(1), file_id, "revision") if (int_array(1) /= REVISION_STATEPOINT) then call fatal_error("State point version does not match current version & &in OpenMC.") end if ! Read and overwrite random number seed - call read_dataset(file_id, "seed", seed) + call read_dataset(seed, file_id, "seed") ! It is not impossible for a state point to be generated from a CE run but ! to be loaded in to an MG run (or vice versa), check to prevent that. - call read_dataset(file_id, "run_CE", sp_run_CE) + call read_dataset(sp_run_CE, file_id, "run_CE") if (sp_run_CE == 0 .and. run_CE) then call fatal_error("State point file is from multi-group run but & & current run is continous-energy!") @@ -731,24 +731,24 @@ contains end if ! Read and overwrite run information except number of batches - call read_dataset(file_id, "run_mode", word) + call read_dataset(word, file_id, "run_mode") select case(word) case ('fixed source') run_mode = MODE_FIXEDSOURCE case ('k-eigenvalue') run_mode = MODE_EIGENVALUE end select - call read_dataset(file_id, "n_particles", n_particles) - call read_dataset(file_id, "n_batches", int_array(1)) + call read_dataset(n_particles, file_id, "n_particles") + call read_dataset(int_array(1), file_id, "n_batches") ! Take maximum of statepoint n_batches and input n_batches n_batches = max(n_batches, int_array(1)) ! Read batch number to restart at - call read_dataset(file_id, "current_batch", restart_batch) + call read_dataset(restart_batch, file_id, "current_batch") ! Check for source in statepoint if needed - call read_dataset(file_id, "source_present", int_array(1)) + call read_dataset(int_array(1), file_id, "source_present") if (int_array(1) == 1) then source_present = .true. else @@ -762,37 +762,37 @@ contains ! Read information specific to eigenvalue run if (run_mode == MODE_EIGENVALUE) then - call read_dataset(file_id, "n_inactive", int_array(1)) - call read_dataset(file_id, "gen_per_batch", gen_per_batch) - call read_dataset(file_id, "k_generation", & - k_generation(1:restart_batch*gen_per_batch)) - call read_dataset(file_id, "entropy", & - entropy(1:restart_batch*gen_per_batch)) - call read_dataset(file_id, "k_col_abs", k_col_abs) - call read_dataset(file_id, "k_col_tra", k_col_tra) - call read_dataset(file_id, "k_abs_tra", k_abs_tra) - call read_dataset(file_id, "k_combined", real_array(1:2)) + call read_dataset(int_array(1), file_id, "n_inactive") + call read_dataset(gen_per_batch, file_id, "gen_per_batch") + call read_dataset(k_generation(1:restart_batch*gen_per_batch), & + file_id, "k_generation") + call read_dataset(entropy(1:restart_batch*gen_per_batch), & + file_id, "entropy") + call read_dataset(k_col_abs, file_id, "k_col_abs") + call read_dataset(k_col_tra, file_id, "k_col_tra") + call read_dataset(k_abs_tra, file_id, "k_abs_tra") + call read_dataset(real_array(1:2), file_id, "k_combined") ! Take maximum of statepoint n_inactive and input n_inactive n_inactive = max(n_inactive, int_array(1)) ! Read in to see if CMFD was on - call read_dataset(file_id, "cmfd_on", int_array(1)) + call read_dataset(int_array(1), file_id, "cmfd_on") ! Read in CMFD info if (int_array(1) == 1) then cmfd_group = open_group(file_id, "cmfd") - call read_dataset(cmfd_group, "indices", cmfd%indices) - call read_dataset(cmfd_group, "k_cmfd", cmfd%k_cmfd(1:restart_batch)) - call read_dataset(cmfd_group, "cmfd_src", cmfd%cmfd_src) - call read_dataset(cmfd_group, "cmfd_entropy", & - cmfd%entropy(1:restart_batch)) - call read_dataset(cmfd_group, "cmfd_balance", & - cmfd%balance(1:restart_batch)) - call read_dataset(cmfd_group, "cmfd_dominance", & - cmfd%dom(1:restart_batch)) - call read_dataset(cmfd_group, "cmfd_srccmp", & - cmfd%src_cmp(1:restart_batch)) + call read_dataset(cmfd%indices, cmfd_group, "indices") + call read_dataset(cmfd%k_cmfd(1:restart_batch), cmfd_group, "k_cmfd") + call read_dataset(cmfd%cmfd_src, cmfd_group, "cmfd_src") + call read_dataset(cmfd%entropy(1:restart_batch), cmfd_group, & + "cmfd_entropy") + call read_dataset(cmfd%balance(1:restart_batch), cmfd_group, & + "cmfd_balance") + call read_dataset(cmfd%dom(1:restart_batch), cmfd_group, & + "cmfd_dominance") + call read_dataset(cmfd%src_cmp(1:restart_batch), cmfd_group, & + "cmfd_srccmp") call close_group(cmfd_group) end if end if @@ -812,14 +812,14 @@ contains #endif ! Read number of realizations for global tallies - call read_dataset(file_id, "n_realizations", n_realizations, indep=.true.) + call read_dataset(n_realizations, file_id, "n_realizations", indep=.true.) ! Read global tally data call read_dataset(file_id, "global_tallies", global_tallies) ! Check if tally results are present tallies_group = open_group(file_id, "tallies") - call read_dataset(tallies_group, "tallies_present", int_array(1), & + call read_dataset(int_array(1), tallies_group, "tallies_present", & indep=.true.) ! Read in sum and sum squared @@ -832,8 +832,8 @@ contains tally_group = open_group(tallies_group, "tally " // & trim(to_str(tally % id))) call read_dataset(tally_group, "results", tally % results) - call read_dataset(tally_group, "n_realizations", & - tally % n_realizations) + call read_dataset(tally % n_realizations, tally_group, & + "n_realizations") call close_group(tally_group) end do TALLY_RESULTS end if @@ -859,7 +859,7 @@ contains file_id = file_open(path_source_point, 'r', parallel=.true.) ! Read file type - call read_dataset(file_id, "filetype", int_array(1)) + call read_dataset(int_array(1), file_id, "filetype") end if From 394d8385c3b814fe27ad1cc5872921719a1bd724 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 15 May 2016 11:24:25 -0500 Subject: [PATCH 2/2] Fix spaces around % as suggested by @smharper --- src/particle_restart.F90 | 28 ++++++++++++++-------------- src/state_point.F90 | 14 +++++++------- 2 files changed, 21 insertions(+), 21 deletions(-) diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index 4040a471a..e5cca17bf 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -34,7 +34,7 @@ contains verbosity = 10 ! Initialize the particle to be tracked - call p%initialize() + call p % initialize() ! Read in the restart information call read_particle_restart(p, previous_run_mode) @@ -46,9 +46,9 @@ contains select case (previous_run_mode) case (MODE_EIGENVALUE) particle_seed = ((current_batch - 1)*gen_per_batch + & - current_gen - 1)*n_particles + p%id + current_gen - 1)*n_particles + p % id case (MODE_FIXEDSOURCE) - particle_seed = p%id + particle_seed = p % id end select call set_particle_seed(particle_seed) @@ -94,19 +94,19 @@ contains case ('fixed source') previous_run_mode = MODE_FIXEDSOURCE end select - call read_dataset(p%id, file_id, 'id') - call read_dataset(p%wgt, file_id, 'weight') - call read_dataset(p%E, file_id, 'energy') - call read_dataset(p%g, file_id, 'energy_group') - call read_dataset(p%coord(1)%xyz, file_id, 'xyz') - call read_dataset(p%coord(1)%uvw, file_id, 'uvw') + call read_dataset(p % id, file_id, 'id') + call read_dataset(p % wgt, file_id, 'weight') + call read_dataset(p % E, file_id, 'energy') + call read_dataset(p % g, file_id, 'energy_group') + call read_dataset(p % coord(1) % xyz, file_id, 'xyz') + call read_dataset(p % coord(1) % uvw, file_id, 'uvw') ! Set particle last attributes - p%last_wgt = p%wgt - p%last_xyz = p%coord(1)%xyz - p%last_uvw = p%coord(1)%uvw - p%last_E = p%E - p%last_g = p%g + p % last_wgt = p % wgt + p % last_xyz = p % coord(1)%xyz + p % last_uvw = p % coord(1)%uvw + p % last_E = p % E + p % last_g = p % g ! Close hdf5 file call file_close(file_id) diff --git a/src/state_point.F90 b/src/state_point.F90 index 81abf0c1b..0006d3042 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -782,16 +782,16 @@ contains ! Read in CMFD info if (int_array(1) == 1) then cmfd_group = open_group(file_id, "cmfd") - call read_dataset(cmfd%indices, cmfd_group, "indices") - call read_dataset(cmfd%k_cmfd(1:restart_batch), cmfd_group, "k_cmfd") - call read_dataset(cmfd%cmfd_src, cmfd_group, "cmfd_src") - call read_dataset(cmfd%entropy(1:restart_batch), cmfd_group, & + call read_dataset(cmfd % indices, cmfd_group, "indices") + call read_dataset(cmfd % k_cmfd(1:restart_batch), cmfd_group, "k_cmfd") + call read_dataset(cmfd % cmfd_src, cmfd_group, "cmfd_src") + call read_dataset(cmfd % entropy(1:restart_batch), cmfd_group, & "cmfd_entropy") - call read_dataset(cmfd%balance(1:restart_batch), cmfd_group, & + call read_dataset(cmfd % balance(1:restart_batch), cmfd_group, & "cmfd_balance") - call read_dataset(cmfd%dom(1:restart_batch), cmfd_group, & + call read_dataset(cmfd % dom(1:restart_batch), cmfd_group, & "cmfd_dominance") - call read_dataset(cmfd%src_cmp(1:restart_batch), cmfd_group, & + call read_dataset(cmfd % src_cmp(1:restart_batch), cmfd_group, & "cmfd_srccmp") call close_group(cmfd_group) end if