From 60c6dea71d201fac69eeb1812dcabfb632163ab7 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 30 Jul 2013 17:26:30 -0400 Subject: [PATCH 01/21] began adding more features to output interface, hdf5 completed up through parallel integer --- src/hdf5_interface.F90 | 1322 ++++++++++++++++++++++++++++++++------ src/output_interface.F90 | 1041 ++++++++++++++++++++++-------- 2 files changed, 1884 insertions(+), 479 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 471a4397cb..8cfdcd8d3d 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -29,20 +29,56 @@ module hdf5_interface interface hdf5_write_data module procedure hdf5_write_double module procedure hdf5_write_double_1Darray + module procedure hdf5_write_double_2Darray + module procedure hdf5_write_double_3Darray + module procedure hdf5_write_double_4Darray module procedure hdf5_write_integer module procedure hdf5_write_integer_1Darray + module procedure hdf5_write_integer_2Darray + module procedure hdf5_write_integer_3Darray + module procedure hdf5_write_integer_4Darray module procedure hdf5_write_long module procedure hdf5_write_string + module procedure hdf5_write_double_parallel + module procedure hdf5_write_double_1Darray_parallel + module procedure hdf5_write_double_2Darray_parallel + module procedure hdf5_write_double_3Darray_parallel + module procedure hdf5_write_double_4Darray_parallel + module procedure hdf5_write_integer_parallel + module procedure hdf5_write_integer_1Darray_parallel + module procedure hdf5_write_integer_2Darray_parallel + module procedure hdf5_write_integer_3Darray_parallel + module procedure hdf5_write_integer_4Darray_parallel + module procedure hdf5_write_long_parallel + module procedure hdf5_write_string_parallel end interface hdf5_write_data ! Generic HDF5 read procedure interface interface hdf5_read_data module procedure hdf5_read_double module procedure hdf5_read_double_1Darray + module procedure hdf5_read_double_2Darray + module procedure hdf5_read_double_3Darray + module procedure hdf5_read_double_4Darray module procedure hdf5_read_integer module procedure hdf5_read_integer_1Darray + module procedure hdf5_read_integer_2Darray + module procedure hdf5_read_integer_3Darray + module procedure hdf5_read_integer_4Darray module procedure hdf5_read_long module procedure hdf5_read_string + module procedure hdf5_read_double_parallel + module procedure hdf5_read_double_1Darray_parallel + module procedure hdf5_read_double_2Darray_parallel + module procedure hdf5_read_double_3Darray_parallel + module procedure hdf5_read_double_4Darray_parallel + module procedure hdf5_read_integer_parallel + module procedure hdf5_read_integer_1Darray_parallel + module procedure hdf5_read_integer_2Darray_parallel + module procedure hdf5_read_integer_3Darray_parallel + module procedure hdf5_read_integer_4Darray_parallel + module procedure hdf5_read_long_parallel + module procedure hdf5_read_string_parallel end interface hdf5_read_data contains @@ -100,10 +136,10 @@ contains #ifdef MPI !=============================================================================== -! HDF5_PARALLEL_FILE_CREATE creates HDF5 file with parallel I/O +! HDF5_FILE_CREATE_PARALLEL creates HDF5 file with parallel I/O !=============================================================================== - subroutine hdf5_parallel_file_create(filename, file_id) + subroutine hdf5_file_create_parallel(filename, file_id) character(*), intent(in) :: filename ! name of file integer(HID_T), intent(inout) :: file_id ! file handle @@ -119,13 +155,13 @@ contains ! Close the property list call h5pclose_f(plist, hdf5_err) - end subroutine hdf5_parallel_file_create + end subroutine hdf5_file_create_parallel !=============================================================================== -! HDF5_PARALLEL_FILE_OPEN opens HDF5 file with parallel I/O +! HDF5_FILE_OPEN_PARALLEL opens HDF5 file with parallel I/O !=============================================================================== - subroutine hdf5_parallel_file_open(filename, file_id, mode) + subroutine hdf5_file_open_parallel(filename, file_id, mode) character(*), intent(in) :: filename ! name of file character(*), intent(in) :: mode ! access mode @@ -150,7 +186,7 @@ contains ! Close the property list call h5pclose_f(plist, hdf5_err) - end subroutine hdf5_parallel_file_open + end subroutine hdf5_file_open_parallel #endif @@ -206,6 +242,27 @@ contains end subroutine hdf5_write_integer +!=============================================================================== +! HDF5_READ_INTEGER reads integer scalar data +!=============================================================================== + + subroutine hdf5_read_integer(group, name, buffer) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(inout) :: buffer ! read data to here + + integer :: buffer_copy(1) ! need an array for read + + ! Set up dimensions + dims1(1) = 1 + + ! Read data + call h5ltread_dataset_int_f(group, name, buffer_copy, dims1, hdf5_err) + buffer = buffer_copy(1) + + end subroutine hdf5_read_integer + !=============================================================================== ! HDF5_WRITE_INTEGER_1DARRAY writes integer 1-D array !=============================================================================== @@ -228,7 +285,26 @@ contains end subroutine hdf5_write_integer_1Darray !=============================================================================== -! HDF5_WRITE_INTEGER_2DARRAY write integer 2-D array +! HDF5_READ_INTEGER_1DARRAY reads integer 1-D array +!=============================================================================== + + subroutine hdf5_read_integer_1Darray(group, name, buffer, length) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(inout) :: buffer(:) ! read data to here + integer, intent(in) :: length ! length of array + + ! Set dimensions + dims1(1) = length + + ! Read data + call h5ltread_dataset_int_f(group, name, buffer, dims1, hdf5_err) + + end subroutine hdf5_read_integer_1Darray + +!=============================================================================== +! HDF5_WRITE_INTEGER_2DARRAY writes integer 2-D array !=============================================================================== subroutine hdf5_write_integer_2Darray(group, name, buffer, length) @@ -248,6 +324,25 @@ contains end subroutine hdf5_write_integer_2Darray +!=============================================================================== +! HDF5_READ_INTEGER_2DARRAY reads integer 2-D array +!=============================================================================== + + subroutine hdf5_read_integer_2Darray(group, name, buffer, length) + + integer, intent(in) :: length(2) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(inout) :: buffer(length(1),length(2)) ! data to read + + ! Set rank and dimensions + dims2 = length + + ! Write data + call h5ltread_dataset_int_f(group, name, buffer, dims2, hdf5_err) + + end subroutine hdf5_read_integer_2Darray + !=============================================================================== ! HDF5_WRITE_INTEGER_3DARRAY writes integer 3-D array !=============================================================================== @@ -257,7 +352,8 @@ contains integer, intent(in) :: length(3) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - integer, intent(in) :: buffer(length(1),length(2), length(3)) ! data + integer, intent(in) :: buffer(length(1),length(2), & + length(3)) ! data to write ! Set rank and dimensions hdf5_rank = 3 @@ -269,6 +365,272 @@ contains end subroutine hdf5_write_integer_3Darray +!=============================================================================== +! HDF5_READ_INTEGER_3DARRAY reads integer 3-D array +!=============================================================================== + + subroutine hdf5_read_integer_3Darray(group, name, buffer, length) + + integer, intent(in) :: length(3) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(inout) :: buffer(length(1),length(2), & + length(3)) ! data to read + + ! Set rank and dimensions + dims3 = length + + ! Write data + call h5ltread_dataset_int_f(group, name, buffer, dims3, hdf5_err) + + end subroutine hdf5_read_integer_3Darray + +!=============================================================================== +! HDF5_WRITE_INTEGER_4DARRAY writes integer 4-D array +!=============================================================================== + + subroutine hdf5_write_integer_4Darray(group, name, buffer, length) + + integer, intent(in) :: length(4) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(in) :: buffer(length(1),length(2), & + length(3),length(4)) ! data to write + + ! Set rank and dimensions + hdf5_rank = 4 + dims4 = length + + ! Write data + call h5ltmake_dataset_int_f(group, name, hdf5_rank, dims4, & + buffer, hdf5_err) + + end subroutine hdf5_write_integer_4Darray + +!=============================================================================== +! HDF5_READ_INTEGER_4DARRAY reads integer 4-D array +!=============================================================================== + + subroutine hdf5_read_integer_4Darray(group, name, buffer, length) + + integer, intent(in) :: length(4) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(inout) :: buffer(length(1),length(2), & + length(3),length(4)) ! data to read + + ! Set rank and dimensions + dims4 = length + + ! Write data + call h5ltread_dataset_int_f(group, name, buffer, dims4, hdf5_err) + + end subroutine hdf5_read_integer_4Darray + +!=============================================================================== +! HDF5_WRITE_DOUBLE writes integer scalar data +!=============================================================================== + + subroutine hdf5_write_double(group, name, buffer) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(in) :: buffer ! data to write + + ! Set rank and dimensions + hdf5_rank = 1 + dims1(1) = 1 + + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & + (/ buffer /), hdf5_err) + + end subroutine hdf5_write_double + +!=============================================================================== +! HDF5_READ_DOUBLE reads integer scalar data +!=============================================================================== + + subroutine hdf5_read_double(group, name, buffer) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(inout) :: buffer ! read data to here + + integer :: buffer_copy(1) ! need an array for read + + ! Set up dimensions + dims1(1) = 1 + + ! Read data + call h5ltread_dataset_double_f(group, name, buffer_copy, dims1, hdf5_err) + buffer = buffer_copy(1) + + end subroutine hdf5_read_double + +!=============================================================================== +! HDF5_WRITE_DOUBLE_1DARRAY writes integer 1-D array +!=============================================================================== + + subroutine hdf5_write_double_1Darray(group, name, buffer, len) + + real(8), intent(in) :: len ! length of array to write + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(in) :: buffer(:) ! data to write + + ! Set rank and dimensions of data + hdf5_rank = 1 + dims1(1) = len + + ! Write data + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & + buffer, hdf5_err) + + end subroutine hdf5_write_double_1Darray + +!=============================================================================== +! HDF5_READ_DOUBLE_1DARRAY reads integer 1-D array +!=============================================================================== + + subroutine hdf5_read_double_1Darray(group, name, buffer, length) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(inout) :: buffer(:) ! read data to here + real(8), intent(in) :: length ! length of array + + ! Set dimensions + dims1(1) = length + + ! Read data + call h5ltread_dataset_double_f(group, name, buffer, dims1, hdf5_err) + + end subroutine hdf5_read_double_1Darray + +!=============================================================================== +! HDF5_WRITE_DOUBLE_2DARRAY writes integer 2-D array +!=============================================================================== + + subroutine hdf5_write_double_2Darray(group, name, buffer, length) + + real(8), intent(in) :: length(2) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(in) :: buffer(length(1),length(2)) ! data to write + + ! Set rank and dimensions + hdf5_rank = 2 + dims2 = length + + ! Write data + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims2, & + buffer, hdf5_err) + + end subroutine hdf5_write_double_2Darray + +!=============================================================================== +! HDF5_READ_DOUBLE_2DARRAY reads integer 2-D array +!=============================================================================== + + subroutine hdf5_write_double_2Darray(group, name, buffer, length) + + real(8), intent(in) :: length(2) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(inout) :: buffer(length(1),length(2)) ! data to read + + ! Set rank and dimensions + dims2 = length + + ! Write data + call h5ltread_dataset_double_f(group, name, buffer, dims2, hdf5_err) + + end subroutine hdf5_read_double_2Darray + +!=============================================================================== +! HDF5_WRITE_DOUBLE_3DARRAY writes integer 3-D array +!=============================================================================== + + subroutine hdf5_write_double_3Darray(group, name, buffer, length) + + real(8), intent(in) :: length(3) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(in) :: buffer(length(1),length(2), & + length(3)) ! data to write + + ! Set rank and dimensions + hdf5_rank = 3 + dims3 = length + + ! Write data + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims3, & + buffer, hdf5_err) + + end subroutine hdf5_write_double_3Darray + +!=============================================================================== +! HDF5_READ_DOUBLE_3DARRAY reads integer 3-D array +!=============================================================================== + + subroutine hdf5_read_double_3Darray(group, name, buffer, length) + + real(8), intent(in) :: length(3) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(inout) :: buffer(length(1),length(2), & + length(3)) ! data to read + + ! Set rank and dimensions + dims3 = length + + ! Write data + call h5ltread_dataset_double_f(group, name, buffer, dims3, hdf5_err) + + end subroutine hdf5_read_double_3Darray + +!=============================================================================== +! HDF5_WRITE_DOUBLE_4DARRAY writes integer 4-D array +!=============================================================================== + + subroutine hdf5_write_double_4Darray(group, name, buffer, length) + + real(8), intent(in) :: length(4) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(in) :: buffer(length(1),length(2), & + length(3),length(4)) ! data to write + + ! Set rank and dimensions + hdf5_rank = 4 + dims4 = length + + ! Write data + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims4, & + buffer, hdf5_err) + + end subroutine hdf5_write_double_4Darray + +!=============================================================================== +! HDF5_READ_DOUBLE_4DARRAY reads integer 4-D array +!=============================================================================== + + subroutine hdf5_read_double_4Darray(group, name, buffer, length) + + real(8), intent(in) :: length(4) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(inout) :: buffer(length(1),length(2), & + length(3),length(4)) ! data to read + + ! Set rank and dimensions + dims4 = length + + ! Write data + call h5ltread_dataset_double_f(group, name, buffer, dims4, hdf5_err) + + end subroutine hdf5_read_double_4Darray + !=============================================================================== ! HDF5_WRITE_LONG writes long integer scalar data !=============================================================================== @@ -299,87 +661,29 @@ contains end subroutine hdf5_write_long !=============================================================================== -! HDF5_WRITE_DOUBLE writes double precision scalar data +! HDF5_READ_LONG read long integer scalar data !=============================================================================== - subroutine hdf5_write_double(group, name, buffer) + subroutine hdf5_read_long(group, name, buffer, long_type) - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer ! data to write + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer(8), target, intent(out) :: buffer ! read data to here + integer(HID_T), intent(in) :: long_type ! long integer type - ! Set up rank and dimensions - hdf5_rank = 1 - dims1(1) = 1 + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) - ! Write data - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & - (/ buffer /), hdf5_err) + ! Get pointer to buffer + f_ptr = c_loc(buffer) - end subroutine hdf5_write_double + ! Read data from dataset + call h5dread_f(dset, long_type, f_ptr, hdf5_err) -!=============================================================================== -! HDF5_WRITE_DOUBLE_1DARRAY writes double precision 1-D array -!=============================================================================== + ! Close dataset + call h5dclose_f(dset, hdf5_err) - subroutine hdf5_write_double_1Darray(group, name, buffer, len) - - integer, intent(in) :: len ! length of array - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer(:) ! data to write - - ! Set rank and dimensions of data - hdf5_rank = 1 - dims1(1) = len - - ! Write data - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & - buffer, hdf5_err) - - end subroutine hdf5_write_double_1Darray - -!=============================================================================== -! HDF5_WRITE_DOUBLE_2DARRAY writes double precision 2-D array -!=============================================================================== - - subroutine hdf5_write_double_2Darray(group, name, buffer, length) - - integer, intent(in) :: length(2) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer(length(1),length(2)) ! data to write - - ! Set rank and dimensions of data - hdf5_rank = 2 - dims2 = length - - ! Write data - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims2, & - buffer, hdf5_err) - - end subroutine hdf5_write_double_2Darray - -!=============================================================================== -! HDF5_WRITE_DOUBLE_3DARRAY writes double precision 3-D aray -!=============================================================================== - - subroutine hdf5_write_double_3Darray(group, name, buffer, length) - - integer, intent(in) :: length(3) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer(length(1),length(2), length(3)) ! data - - ! Set rank and dimensions - hdf5_rank = 3 - dims3 = length - - ! Write data - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims3, & - buffer, hdf5_err) - - end subroutine hdf5_write_double_3Darray + end subroutine hdf5_read_long !=============================================================================== ! HDF5_WRITE_STRING writes string data @@ -431,6 +735,20 @@ contains end subroutine hdf5_write_string +!=============================================================================== +! HDF5_READ_STRING reads string data +!=============================================================================== + + subroutine hdf5_read_string(group, name, buffer) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + character(*), intent(inout) :: buffer ! read data to here + + call h5ltread_dataset_string_f(group, name, buffer, hdf5_err) + + end subroutine hdf5_read_string + !=============================================================================== ! HDF5_WRITE_ATTRIBUTE_STRING writes a string attribute to a variables !=============================================================================== @@ -446,126 +764,6 @@ contains end subroutine hdf5_write_attribute_string -!=============================================================================== -! HDF5_READ_INTEGER reads integer scalar data -!=============================================================================== - - subroutine hdf5_read_integer(group, name, buffer) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, intent(inout) :: buffer ! read data to here - - integer :: buffer_copy(1) ! need an array for read - - ! Set up dimensions - dims1(1) = 1 - - ! Read data - call h5ltread_dataset_int_f(group, name, buffer_copy, dims1, hdf5_err) - buffer = buffer_copy(1) - - end subroutine hdf5_read_integer - -!=============================================================================== -! HDF5_READ_INTEGER_1DARRAY reads integer 1-D array -!=============================================================================== - - subroutine hdf5_read_integer_1Darray(group, name, buffer, length) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, intent(inout) :: buffer(:) ! read data to here - integer, intent(in) :: length ! length of array - - ! Set dimensions - dims1(1) = length - - ! Read data - call h5ltread_dataset_int_f(group, name, buffer, dims1, hdf5_err) - - end subroutine hdf5_read_integer_1Darray - - -!=============================================================================== -! HDF5_READ_LONG read long integer scalar data -!=============================================================================== - - subroutine hdf5_read_long(group, name, buffer, long_type) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer(8), target, intent(out) :: buffer ! read data to here - integer(HID_T), intent(in) :: long_type ! long integer type - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Get pointer to buffer - f_ptr = c_loc(buffer) - - ! Read data from dataset - call h5dread_f(dset, long_type, f_ptr, hdf5_err) - - ! Close dataset - call h5dclose_f(dset, hdf5_err) - - end subroutine hdf5_read_long - -!=============================================================================== -! HDF5_READ_DOUBLE reads double precision scalar data -!=============================================================================== - - subroutine hdf5_read_double(group, name, buffer) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer ! read data to here - - real(8) :: buffer_copy(1) ! need an array for read - - ! Set up dimensions - dims1(1) = 1 - - ! Read data - call h5ltread_dataset_double_f(group, name, buffer_copy, dims1, hdf5_err) - buffer = buffer_copy(1) - - end subroutine hdf5_read_double - -!=============================================================================== -! HDF5_READ_DOUBLE_1DARRAY reads double precision 1-D array -!=============================================================================== - - subroutine hdf5_read_double_1Darray(group, name, buffer, length) - - integer(HID_T), intent(in) :: group ! name of group - integer, intent(in) :: length ! length of array - character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer(:) ! read data to here - - ! Set dimensions of data - dims1(1) = length - - ! Read data - call h5ltread_dataset_double_f(group, name, buffer, dims1, hdf5_err) - - end subroutine hdf5_read_double_1Darray - -!=============================================================================== -! HDF5_READ_STRING reads string data -!=============================================================================== - - subroutine hdf5_read_string(group, name, buffer) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - character(*), intent(inout) :: buffer ! read data to here - - call h5ltread_dataset_string_f(group, name, buffer, hdf5_err) - - end subroutine hdf5_read_string - # ifdef MPI !=============================================================================== ! HDF5_PARALLEL_READ_INTEGER reads interger scalar data in parallel @@ -777,6 +975,728 @@ contains end subroutine hdf5_parallel_read_string +!=============================================================================== +! HDF5_WRITE_INTEGER_PARALLEL writes integer scalar data in parallel +!=============================================================================== + + subroutine hdf5_write_integer_parallel(group, name, buffer, collect) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(in) :: buffer ! data to write + logical, intent(in) :: collect ! collect I/O + + ! Set rank and dimensions + hdf5_rank = 1 + dims1(1) = 1 + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + end if + + ! Create dataspace + call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) + + ! Write data + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_write_integer_parallel + +!=============================================================================== +! HDF5_READ_INTEGER_PARALLEL reads integer scalar data +!=============================================================================== + + subroutine hdf5_read_integer_parallel(group, name, buffer, collect) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, target, intent(inout) :: buffer ! read data to here + logical, intent(in) :: collect ! collective I/O + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + end if + + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) + + ! Read data + f_ptr = c_loc(buffer) + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close dataset and property list + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_read_integer_parallel + +!=============================================================================== +! HDF5_WRITE_INTEGER_1DARRAY_PARALLEL writes integer 1-D array in parallel +!=============================================================================== + + subroutine hdf5_write_integer_1Darray_parallel(group, name, buffer, length, & + collect) + + integer, intent(in) :: length ! length of array to write + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(in) :: buffer(:) ! data to write + logical, intent(in) :: collect ! collect I/O + + ! Set rank and dimensions of data + hdf5_rank = 1 + dims1(1) = length + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + end if + + ! Create dataspace + call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) + + ! Write data + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_write_integer_1Darray_parallel + +!=============================================================================== +! HDF5_WRITE_INTEGER_1DARRAY_PARALLEL reads integer 1-D array in parallel +!=============================================================================== + + subroutine hdf5_read_integer_1Darray_parallel(group, name, buffer, length, & + collect) + + integer, intent(in) :: length ! length of array + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, target, intent(inout) :: buffer ! read data to here + logical, intent(in) :: collect ! collective I/O + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + end if + + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) + + ! Read data + f_ptr = c_loc(buffer) + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close dataset and property list + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_read_integer_1Darray_parallel + +!=============================================================================== +! HDF5_WRITE_INTEGER_2DARRAY_PARALLEL writes integer 2-D array in parallel +!=============================================================================== + + subroutine hdf5_write_integer_2Darray_parallel(group, name, buffer, length, & + collect) + + integer, intent(in) :: length(2) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(in) :: buffer(length(1),length(2)) ! data to write + logical, intent(in) :: collect ! collective I/O + + ! Set rank and dimensions + hdf5_rank = 2 + dims2 = length + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + end if + + ! Create dataspace + call h5screate_simple_f(hdf5_rank, dims2, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) + + ! Write data + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_write_integer_2Darray_parallel + +!=============================================================================== +! HDF5_READ_INTEGER_2DARRAY_PARALLEL reads integer 2-D array in parallel +!=============================================================================== + + subroutine hdf5_read_integer_2Darray_parallel(group, name, buffer, length, & + collect) + + integer, intent(in) :: length(2) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(inout) :: buffer(length(1),length(2)) ! data to read + logical, intent(in) :: collect ! collect I/O + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + end if + + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) + + ! Read data + f_ptr = c_loc(buffer) + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close dataset and property list + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_read_integer_2Darray_parallel + +!=============================================================================== +! HDF5_WRITE_INTEGER_3DARRAY_PARALLEL writes integer 3-D array in parallel +!=============================================================================== + + subroutine hdf5_write_integer_3Darray_parallel(group, name, buffer, length, & + collect) + + integer, intent(in) :: length(3) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(in) :: buffer(length(1),length(2), & + length(3)) ! data to write + logical, intent(in) :: collect ! collective I/O + + ! Set rank and dimensions + hdf5_rank = 3 + dims3 = length + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + end if + + ! Create dataspace + call h5screate_simple_f(hdf5_rank, dims3, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) + + ! Write data + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_write_integer_3Darray_parallel + +!=============================================================================== +! HDF5_READ_INTEGER_3DARRAY_PARALLEL reads integer 3-D array in parallel +!=============================================================================== + + subroutine hdf5_read_integer_3Darray_parallel(group, name, buffer, length, & + collect) + + integer, intent(in) :: length(3) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(inout) :: buffer(length(1),length(2), & + length(3)) ! data to read + logical, intent(in) :: collect ! collective I/O + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + end if + + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) + + ! Read data + f_ptr = c_loc(buffer) + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close dataset and property list + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_read_integer_3Darray_parallel + +!=============================================================================== +! HDF5_WRITE_INTEGER_4DARRAY_PARALLEL writes integer 4-D array in parallel +!=============================================================================== + + subroutine hdf5_write_integer_4Darray_parallel(group, name, buffer, length, & + collect) + + integer, intent(in) :: length(4) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(in) :: buffer(length(1),length(2), & + length(3),length(4)) ! data to write + logical, intent(in) :: collect ! collective I/O + + ! Set rank and dimensions + hdf5_rank = 4 + dims4 = length + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + end if + + ! Create dataspace + call h5screate_simple_f(hdf5_rank, dims4, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) + + ! Write data + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_write_integer_4Darray_parallel + +!=============================================================================== +! HDF5_READ_INTEGER_4DARRAY_PARALLEL reads integer 4-D array in parallel +!=============================================================================== + + subroutine hdf5_read_integer_4Darray_parallel(group, name, buffer, length, & + collect) + + integer, intent(in) :: length(4) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(inout) :: buffer(length(1),length(2), & + length(3),length(4)) ! data to read + logical, intent(in) :: collect ! collective I/O + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + end if + + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) + + ! Read data + f_ptr = c_loc(buffer) + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close dataset and property list + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_read_integer_4Darray_parallel + +!=============================================================================== +! HDF5_WRITE_DOUBLE writes integer scalar data +!=============================================================================== + + subroutine hdf5_write_double(group, name, buffer) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(in) :: buffer ! data to write + + ! Set rank and dimensions + hdf5_rank = 1 + dims1(1) = 1 + + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & + (/ buffer /), hdf5_err) + + end subroutine hdf5_write_double + +!=============================================================================== +! HDF5_READ_DOUBLE reads integer scalar data +!=============================================================================== + + subroutine hdf5_read_double(group, name, buffer) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(inout) :: buffer ! read data to here + + integer :: buffer_copy(1) ! need an array for read + + ! Set up dimensions + dims1(1) = 1 + + ! Read data + call h5ltread_dataset_double_f(group, name, buffer_copy, dims1, hdf5_err) + buffer = buffer_copy(1) + + end subroutine hdf5_read_double + +!=============================================================================== +! HDF5_WRITE_DOUBLE_1DARRAY writes integer 1-D array +!=============================================================================== + + subroutine hdf5_write_double_1Darray(group, name, buffer, len) + + real(8), intent(in) :: len ! length of array to write + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(in) :: buffer(:) ! data to write + + ! Set rank and dimensions of data + hdf5_rank = 1 + dims1(1) = len + + ! Write data + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & + buffer, hdf5_err) + + end subroutine hdf5_write_double_1Darray + +!=============================================================================== +! HDF5_READ_DOUBLE_1DARRAY reads integer 1-D array +!=============================================================================== + + subroutine hdf5_read_double_1Darray(group, name, buffer, length) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(inout) :: buffer(:) ! read data to here + real(8), intent(in) :: length ! length of array + + ! Set dimensions + dims1(1) = length + + ! Read data + call h5ltread_dataset_double_f(group, name, buffer, dims1, hdf5_err) + + end subroutine hdf5_read_double_1Darray + +!=============================================================================== +! HDF5_WRITE_DOUBLE_2DARRAY writes integer 2-D array +!=============================================================================== + + subroutine hdf5_write_double_2Darray(group, name, buffer, length) + + real(8), intent(in) :: length(2) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(in) :: buffer(length(1),length(2)) ! data to write + + ! Set rank and dimensions + hdf5_rank = 2 + dims2 = length + + ! Write data + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims2, & + buffer, hdf5_err) + + end subroutine hdf5_write_double_2Darray + +!=============================================================================== +! HDF5_READ_DOUBLE_2DARRAY reads integer 2-D array +!=============================================================================== + + subroutine hdf5_write_double_2Darray(group, name, buffer, length) + + real(8), intent(in) :: length(2) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(inout) :: buffer(length(1),length(2)) ! data to read + + ! Set rank and dimensions + dims2 = length + + ! Write data + call h5ltread_dataset_double_f(group, name, buffer, dims2, hdf5_err) + + end subroutine hdf5_read_double_2Darray + +!=============================================================================== +! HDF5_WRITE_DOUBLE_3DARRAY writes integer 3-D array +!=============================================================================== + + subroutine hdf5_write_double_3Darray(group, name, buffer, length) + + real(8), intent(in) :: length(3) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(in) :: buffer(length(1),length(2), & + length(3)) ! data to write + + ! Set rank and dimensions + hdf5_rank = 3 + dims3 = length + + ! Write data + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims3, & + buffer, hdf5_err) + + end subroutine hdf5_write_double_3Darray + +!=============================================================================== +! HDF5_READ_DOUBLE_3DARRAY reads integer 3-D array +!=============================================================================== + + subroutine hdf5_read_double_3Darray(group, name, buffer, length) + + real(8), intent(in) :: length(3) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(inout) :: buffer(length(1),length(2), & + length(3)) ! data to read + + ! Set rank and dimensions + dims3 = length + + ! Write data + call h5ltread_dataset_double_f(group, name, buffer, dims3, hdf5_err) + + end subroutine hdf5_read_double_3Darray + +!=============================================================================== +! HDF5_WRITE_DOUBLE_4DARRAY writes integer 4-D array +!=============================================================================== + + subroutine hdf5_write_double_4Darray(group, name, buffer, length) + + real(8), intent(in) :: length(4) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(in) :: buffer(length(1),length(2), & + length(3),length(4)) ! data to write + + ! Set rank and dimensions + hdf5_rank = 4 + dims4 = length + + ! Write data + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims4, & + buffer, hdf5_err) + + end subroutine hdf5_write_double_4Darray + +!=============================================================================== +! HDF5_READ_DOUBLE_4DARRAY reads integer 4-D array +!=============================================================================== + + subroutine hdf5_read_double_4Darray(group, name, buffer, length) + + real(8), intent(in) :: length(4) ! length of array dimensions + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(inout) :: buffer(length(1),length(2), & + length(3),length(4)) ! data to read + + ! Set rank and dimensions + dims4 = length + + ! Write data + call h5ltread_dataset_double_f(group, name, buffer, dims4, hdf5_err) + + end subroutine hdf5_read_double_4Darray + +!=============================================================================== +! HDF5_WRITE_LONG writes long integer scalar data +!=============================================================================== + + subroutine hdf5_write_long(group, name, buffer, long_type) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer(8), target, intent(in) :: buffer ! data to write + integer(HID_T), intent(in) :: long_type ! HDF5 long type + + ! Set up rank and dimensions + hdf5_rank = 1 + dims1(1) = 1 + + ! Create dataspace and dataset + call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) + call h5dcreate_f(group, name, long_type, dspace, dset, hdf5_err) + + ! Write eight-byte integer + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, long_type, f_ptr, hdf5_err) + + ! Close dataspace and dataset for long integer + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + + end subroutine hdf5_write_long + +!=============================================================================== +! HDF5_READ_LONG read long integer scalar data +!=============================================================================== + + subroutine hdf5_read_long(group, name, buffer, long_type) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer(8), target, intent(out) :: buffer ! read data to here + integer(HID_T), intent(in) :: long_type ! long integer type + + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) + + ! Get pointer to buffer + f_ptr = c_loc(buffer) + + ! Read data from dataset + call h5dread_f(dset, long_type, f_ptr, hdf5_err) + + ! Close dataset + call h5dclose_f(dset, hdf5_err) + + end subroutine hdf5_read_long + +!=============================================================================== +! HDF5_WRITE_STRING writes string data +!=============================================================================== + + subroutine hdf5_write_string(group, name, buffer, length) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + character(*), intent(in) :: buffer ! data to write + integer, intent(in) :: length + + character(len=length), dimension(1) :: str_tmp + +! Fortran 2003 implementation not compatible with IBM compiler Feb 2013 +! type(c_ptr), dimension(1), target :: wdata +! character(len=length, kind=c_char), dimension(1), target :: c_str +! dims1(1) = 1 +! call h5screate_simple_f(1, dims1, dspace, hdf5_err) +! call h5dcreate_f(group, name, H5T_STRING, dspace, dset, hdf5_err) +! c_str(1) = buffer +! wdata(1) = c_loc(c_str(1)) +! f_ptr = c_loc(wdata(1)) + + ! Number of strings to write + dims1(1) = 1 + + ! Insert null character at end of string when writing + call h5tset_strpad_f(H5T_STRING, H5T_STR_NULLPAD_F, hdf5_err) + + ! Create the dataspace and dataset + call h5screate_simple_f(1, dims1, dspace, hdf5_err) + call h5dcreate_f(group, name, H5T_STRING, dspace, dset, hdf5_err) + + ! Set up dimesnions of string to write + dims2 = (/length, 1/) ! full array of strings to write + dims1(1) = length ! length of string + + ! Copy over string buffer to a rank 1 array + str_tmp(1) = buffer + + ! Write the variable dataset + call h5dwrite_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, & + mem_space_id=dspace) + + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + + end subroutine hdf5_write_string + +!=============================================================================== +! HDF5_READ_STRING reads string data +!=============================================================================== + + subroutine hdf5_read_string(group, name, buffer) + + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + character(*), intent(inout) :: buffer ! read data to here + + call h5ltread_dataset_string_f(group, name, buffer, hdf5_err) + + end subroutine hdf5_read_string + # endif #endif diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 5f421a6d25..8806a8a060 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -19,6 +19,7 @@ module output_interface module procedure write_double_1Darray module procedure write_double_2Darray module procedure write_double_3Darray + module procedure write_double_4Darray module procedure write_integer module procedure write_integer_1Darray module procedure write_integer_2Darray @@ -31,6 +32,7 @@ module output_interface interface read_data module procedure read_double module procedure read_double_1Darray + module procedure read_double_4Darray module procedure read_integer module procedure read_integer_1Darray module procedure read_long @@ -153,11 +155,21 @@ contains ! WRITE_DOUBLE writes double precision scalar data !=============================================================================== - subroutine write_double(buffer, name, group) + subroutine write_double(buffer, name, group, collect) - real(8), intent(in) :: buffer ! data to write - character(*), intent(in) :: name ! name for data - character(*), intent(in), optional :: group ! HDF5 group name + real(8), intent(in) :: buffer ! data to write + character(*), intent(in) :: name ! name for data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -166,14 +178,17 @@ contains else temp_group = hdf5_fh endif - +# ifdef MPI + ! Write the data using parallel routine + call hdf5_write_double_parallel(temp_group, name, buffer, collect_) +# else ! Write the data call hdf5_write_double(temp_group, name, buffer) - +# endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI - call mpi_write_double(mpi_fh, buffer) + call mpi_write_double(mpi_fh, buffer, collect_) #else write(UNIT_OUTPUT) buffer #endif @@ -184,12 +199,21 @@ contains ! READ_DOUBLE reads double precision scalar data !=============================================================================== - subroutine read_double(buffer, name, group, option) + subroutine read_double(buffer, name, group, collect) - real(8), intent(inout) :: buffer ! read data to here - character(*), intent(in) :: name ! name for data - character(*), intent(in), optional :: group ! HDF5 group name - character(*), intent(in), optional :: option ! type of read + real(8), intent(inout) :: buffer ! read data to here + character(*), intent(in) :: name ! name for data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -199,27 +223,16 @@ contains temp_group = hdf5_fh endif # ifdef MPI - ! Check for option for reading default is independent - if (present(option)) then - if (option == 'collective') then - call hdf5_parallel_read_double(temp_group, name, buffer, & - H5FD_MPIO_COLLECTIVE_F) - else - call hdf5_parallel_read_double(temp_group, name, buffer, & - H5FD_MPIO_INDEPENDENT_F) - end if - else - ! Standard read call - call hdf5_read_double(temp_group, name, buffer) - end if + ! Read the data using parallel routines + call hdf5_read_double_parallel(temp_group, name, buffer, collect_) # else - ! Read the data serial + ! Read the data in serial call hdf5_read_double(temp_group, name, buffer) # endif ! Check if HDf5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI - call mpi_read_double(mpi_fh, buffer) + call mpi_read_double(mpi_fh, buffer, collect_) #else read(UNIT_OUTPUT) buffer #endif @@ -230,12 +243,22 @@ contains ! WRITE_DOUBLE_1DARRAY writes double presicions 1-D array data !=============================================================================== - subroutine write_double_1Darray(buffer, name, group, length) + subroutine write_double_1Darray(buffer, name, group, length, collect) integer, intent(in) :: length ! length of array to write real(8), intent(in) :: buffer(:) ! data to write character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -244,10 +267,13 @@ contains else temp_group = hdf5_fh endif - - ! Write the data +# ifdef MPI + ! Write the data using parallel routine + call hdf5_write_double_1Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else call hdf5_write_double_1Darray(temp_group, name, buffer, length) - +# endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI @@ -262,13 +288,22 @@ contains ! READ_DOUBLE_1DARRAY reads double precision 1-D array data !=============================================================================== - subroutine read_double_1Darray(buffer, name, group, length, option) + subroutine read_double_1Darray(buffer, name, group, length, collect) integer, intent(in) :: length ! length of array to read real(8), intent(inout) :: buffer(:) ! read data to here character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name - character(*), intent(in), optional :: option ! read option + character(*), intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -278,21 +313,11 @@ contains temp_group = hdf5_fh endif # ifdef MPI - ! Check for option for reading default is independent - if (present(option)) then - if (option == 'collective') then - call hdf5_parallel_read_double_1Darray(temp_group, name, buffer, & - length, H5FD_MPIO_COLLECTIVE_F) - else - call hdf5_parallel_read_double_1Darray(temp_group, name, buffer, & - length, H5FD_MPIO_INDEPENDENT_F) - end if - else - ! Standard read call - call hdf5_read_double_1Darray(temp_group, name, buffer, length) - end if + ! Read the data using parallel routines + call hdf5_read_double_1Darray_parallel(temp_group, name, buffer, & + length, collect_) # else - ! Read the data serial + ! Read the data in serial call hdf5_read_double_1Darray(temp_group, name, buffer, length) # endif ! Check if HDF5 group should be closed @@ -309,105 +334,22 @@ contains ! WRITE_DOUBLE_2DARRAY writes double precision 2-D array data !=============================================================================== - subroutine write_double_2Darray(buffer, name, group, length) + subroutine write_double_2Darray(buffer, name, group, length, collect) integer, intent(in) :: length(2) ! dimension of array real(8), intent(in) :: buffer(length(1),length(2)) ! the data character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O -#ifdef HDF5 - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(group) + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect else - temp_group = hdf5_fh - endif - - ! Write the data - call hdf5_write_double_2Darray(temp_group, name, buffer, length) - - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() -#else - message = 'Double precision 2-D array writing not currently supported' - call warning() -#endif - - end subroutine write_double_2Darray - -!=============================================================================== -! WRITE_DOUBLE_3DARRAY writes double precision 3-D array data -!=============================================================================== - - subroutine write_double_3Darray(buffer, name, group, length) - - integer, intent(in) :: length(3) ! length of each dimension - real(8), intent(in) :: buffer(length(1),length(2),length(3)) - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - -#ifdef HDF5 - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(group) - else - temp_group = hdf5_fh - endif - - ! Write the data - call hdf5_write_double_3Darray(temp_group, name, buffer, length) - - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() -#else - message = 'Double precision 3-D array writing not currently supported' - call warning() -#endif - - end subroutine write_double_3Darray - -!=============================================================================== -! WRITE_INTEGER writes integer scalar data -!=============================================================================== - - subroutine write_integer(buffer, name, group) - - integer, intent(in) :: buffer ! data to write - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - -#ifdef HDF5 - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(group) - else - temp_group = hdf5_fh - endif - - ! Write data - call hdf5_write_integer(temp_group, name, buffer) - - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() -#elif MPI - call mpi_write_integer(mpi_fh, buffer) -#else - write(UNIT_OUTPUT) buffer -#endif - - end subroutine write_integer - -!=============================================================================== -! READ_INTEGER reads integer scalar data -!=============================================================================== - - subroutine read_integer(buffer, name, group, option) - - integer, intent(inout) :: buffer ! read data to here - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - character(*), intent(in), optional :: option ! read option + collect_ = .true. + end if #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -417,27 +359,335 @@ contains temp_group = hdf5_fh endif # ifdef MPI - ! Check for option for reading default is independent - if (present(option)) then - if (option == 'collective') then - call hdf5_parallel_read_integer(temp_group, name, buffer, & - H5FD_MPIO_COLLECTIVE_F) - else - call hdf5_parallel_read_integer(temp_group, name, buffer, & - H5FD_MPIO_INDEPENDENT_F) - end if - else - ! Standard read call - call hdf5_read_integer(temp_group, name, buffer) - end if + ! Write the data using parallel routines + call hdf5_write_double_2Darray_parallel(temp_group, name, buffer, length, & + collect_) # else - ! Read the data serial - call hdf5_read_integer(temp_group, name, buffer) + ! Write the data in serial + call hdf5_write_double_2Darray(temp_group, name, buffer, length) # endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI - call mpi_read_integer(mpi_fh, buffer) + call mpi_write_double_2Darray(mpi_fh, buffer, length, collect_) +#else + write(UNIT_OUTPUT) buffer(1:length(1),1:length(2)) +#endif + + end subroutine write_double_2Darray + +!=============================================================================== +! READ_DOUBLE_2DARRAY reads double precision 2-D array data +!=============================================================================== + + subroutine reads_double_2Darray(buffer, name, group, length, collect) + + integer, intent(in) :: length(2) ! dimension of array + real(8), intent(inout) :: buffer(length(1),length(2)) ! the data + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if + +#ifdef HDF5 + ! Check if HDF5 group should be created/opened + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif +# ifdef MPI + ! Read the data using parallel routines + call hdf5_read_double_2Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else + ! Read the data in serial + call hdf5_read_double_2Darray(temp_group, name, buffer, length) +# endif + ! Check if HDF5 group should be closed + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_read_double_2Darray(mpi_fh, buffer, length, collect_) +#else + read(UNIT_OUTPUT) buffer(1:length(1),1:length(2)) +#endif + + end subroutine read_double_2Darray + +!=============================================================================== +! WRITE_DOUBLE_3DARRAY writes double precision 3-D array data +!=============================================================================== + + subroutine write_double_3Darray(buffer, name, group, length, collect) + + integer, intent(in) :: length(3) ! length of each dimension + real(8), intent(in) :: buffer(length(1),length(2),length(3)) + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if + +#ifdef HDF5 + ! Check if HDF5 group should be created/opened + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif +# ifdef MPI + ! Write the data using parallel routines + call hdf5_write_double_3Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else + ! Write the data in serial + call hdf5_write_double_3Darray(temp_group, name, buffer, length) +# endif + ! Check if HDF5 group should be closed + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_write_double_3Darray(mpi_fh, buffer, length, collect_) +#else + write(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3)) +#endif + + end subroutine write_double_3Darray + +!=============================================================================== +! READ_DOUBLE_3DARRAY reads double precision 3-D array data +!=============================================================================== + + subroutine read_double_3Darray(buffer, name, group, length, collect) + + integer, intent(in) :: length(3) ! length of each dimension + real(8), intent(inout) :: buffer(length(1),length(2),length(3)) + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if + +#ifdef HDF5 + ! Check if HDF5 group should be created/opened + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif +# ifdef MPI + ! Read the data using parallel routines + call hdf5_read_double_3Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else + ! Read the data in serial + call hdf5_read_double_3Darray(temp_group, name, buffer, length) +# endif + ! Check if HDF5 group should be closed + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_read_double_3Darray(mpi_fh, buffer, length, collect_) +#else + read(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3)) +#endif + + end subroutine read_double_3Darray + +!=============================================================================== +! WRITE_DOUBLE_4DARRAY writes double precision 4-D array data +!=============================================================================== + + subroutine write_double_4Darray(buffer, name, group, length, collect) + + integer, intent(in) :: length(4) ! length of each dimension + real(8), intent(in) :: buffer(length(1),length(2),& + length(3),length(4)) + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if + +#ifdef HDF5 + ! Check if HDF5 group should be created/opened + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif +# ifdef MPI + ! Write the data using parallel routines + call hdf5_write_double_4Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else + ! Write the data in serial + call hdf5_write_double_4Darray(temp_group, name, buffer, length) +# endif + ! Check if HDF5 group should be closed + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_write_double_4Darray(mpi_fh, buffer, length, collect_) +#else + write(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3), & + 1:length(4)) +#endif + + end subroutine write_double_4Darray + +!=============================================================================== +! READ_DOUBLE_4DARRAY reads double precision 4-D array data +!=============================================================================== + + subroutine read_double_4Darray(buffer, name, group, length, collect) + + integer, intent(in) :: length(4) ! length of each dimension + real(8), intent(inout) :: buffer(length(1),length(2),& + length(3),length(4)) + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if + +#ifdef HDF5 + ! Check if HDF5 group should be created/opened + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif +# ifdef MPI + ! Read the data using parallel routines + call hdf5_read_double_4Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else + ! Read the data in serial + call hdf5_read_double_4Darray(temp_group, name, buffer, length) +# endif + ! Check if HDF5 group should be closed + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_read_double_4Darray(mpi_fh, buffer, length, collect_) +#else + read(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3), & + 1:length(4)) +#endif + + end subroutine read_double_4Darray + +!=============================================================================== +! WRITE_INTEGER writes integer precision scalar data +!=============================================================================== + + subroutine write_integer(buffer, name, group, collect) + + integer, intent(in) :: buffer ! data to write + character(*), intent(in) :: name ! name for data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if + +#ifdef HDF5 + ! Check if HDF5 group should be created/opened + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif +# ifdef MPI + ! Write the data using parallel routine + call hdf5_write_integer_parallel(temp_group, name, buffer, collect_) +# else + ! Write the data + call hdf5_write_integer(temp_group, name, buffer) +# endif + ! Check if HDF5 group should be closed + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_write_integer(mpi_fh, buffer, collect_) +#else + write(UNIT_OUTPUT) buffer +#endif + + end subroutine write_integer + +!=============================================================================== +! READ_INTEGER reads integer precision scalar data +!=============================================================================== + + subroutine read_integer(buffer, name, group, collect) + + integer, intent(inout) :: buffer ! read data to here + character(*), intent(in) :: name ! name for data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if + +#ifdef HDF5 + ! Check if HDF5 group should be created/opened + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif +# ifdef MPI + ! Read the data using parallel routines + call hdf5_read_integer_parallel(temp_group, name, buffer, collect_) +# else + ! Read the data in serial + call hdf5_read_integer(temp_group, name, buffer) +# endif + ! Check if HDf5 group should be closed + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_read_integer(mpi_fh, buffer, collect_) #else read(UNIT_OUTPUT) buffer #endif @@ -445,28 +695,40 @@ contains end subroutine read_integer !=============================================================================== -! WRITE_INTEGER_1DARRAY writes integer 1-D array data +! WRITE_INTEGER_1DARRAY writes integer presicions 1-D array data !=============================================================================== - subroutine write_integer_1Darray(buffer, name, group, length) + subroutine write_integer_1Darray(buffer, name, group, length, collect) integer, intent(in) :: length ! length of array to write integer, intent(in) :: buffer(:) ! data to write character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if #ifdef HDF5 - ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(group) else temp_group = hdf5_fh endif - - ! Write the data +# ifdef MPI + ! Write the data using parallel routine + call hdf5_write_integer_1Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else call hdf5_write_integer_1Darray(temp_group, name, buffer, length) - +# endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI @@ -478,16 +740,25 @@ contains end subroutine write_integer_1Darray !=============================================================================== -! READ_INTEGER_1DARRAY reads integer 1-D array data +! READ_INTEGER_1DARRAY reads integer precision 1-D array data !=============================================================================== - subroutine read_integer_1Darray(buffer, name, group, length, option) + subroutine read_integer_1Darray(buffer, name, group, length, collect) - integer, intent(in) :: length ! length of array to read - integer, intent(inout) :: buffer(:) ! read data to here - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - character(*), intent(in), optional :: option ! read option + integer, intent(in) :: length ! length of array to read + integer, intent(inout) :: buffer(:) ! read data to here + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + character(*), intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -497,23 +768,14 @@ contains temp_group = hdf5_fh endif # ifdef MPI - ! Check for option for reading default is independent - if (present(option)) then - if (option == 'collective') then - call hdf5_parallel_read_integer_1Darray(temp_group, name, buffer, & - length, H5FD_MPIO_COLLECTIVE_F) - else - call hdf5_parallel_read_integer_1Darray(temp_group, name, buffer, & - length, H5FD_MPIO_INDEPENDENT_F) - end if - else - ! Standard read call - call hdf5_read_integer_1Darray(temp_group, name, buffer, length) - end if + ! Read the data using parallel routines + call hdf5_read_integer_1Darray_parallel(temp_group, name, buffer, & + length, collect_) # else - ! Read the data serial + ! Read the data in serial call hdf5_read_integer_1Darray(temp_group, name, buffer, length) # endif + ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI call mpi_read_integer_1Darray(mpi_fh, buffer, length) @@ -524,15 +786,25 @@ contains end subroutine read_integer_1Darray !=============================================================================== -! WRITE_INTEGER_2DARRAY writes integer 2-D array data +! WRITE_INTEGER_2DARRAY writes integer precision 2-D array data !=============================================================================== - subroutine write_integer_2Darray(buffer, name, group, length) + subroutine write_integer_2Darray(buffer, name, group, length, collect) - integer, intent(in) :: length(2) ! length of dimensions - integer, intent(in) :: buffer(length(1),length(2)) ! data + integer, intent(in) :: length(2) ! dimension of array + integer, intent(in) :: buffer(length(1),length(2)) ! the data character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -541,29 +813,44 @@ contains else temp_group = hdf5_fh endif - - ! Write the data +# ifdef MPI + ! Write the data using parallel routines + call hdf5_write_integer_2Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else + ! Write the data in serial call hdf5_write_integer_2Darray(temp_group, name, buffer, length) - +# endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_write_integer_2Darray(mpi_fh, buffer, length, collect_) #else - message = 'Integer 2-D array writing not currently supported' - call warning() + write(UNIT_OUTPUT) buffer(1:length(1),1:length(2)) #endif end subroutine write_integer_2Darray !=============================================================================== -! WRITE_INTEGER_3DARRAY writes integer 3-D array data +! READ_INTEGER_2DARRAY reads integer precision 2-D array data !=============================================================================== - subroutine write_integer_3Darray(buffer, name, group, length) + subroutine reads_integer_2Darray(buffer, name, group, length, collect) - integer, intent(in) :: length(3) ! length of dimensions - integer, intent(in) :: buffer(length(1),length(2),length(3)) + integer, intent(in) :: length(2) ! dimension of array + integer, intent(inout) :: buffer(length(1),length(2)) ! the data character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -572,28 +859,86 @@ contains else temp_group = hdf5_fh endif - - ! Write the data - call hdf5_write_integer_3Darray(temp_group, name, buffer, length) - +# ifdef MPI + ! Read the data using parallel routines + call hdf5_read_integer_2Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else + ! Read the data in serial + call hdf5_read_integer_2Darray(temp_group, name, buffer, length) +# endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_read_integer_2Darray(mpi_fh, buffer, length, collect_) #else - message = 'Integer 3-D array writing not currently supported' - call warning() + read(UNIT_OUTPUT) buffer(1:length(1),1:length(2)) +#endif + + end subroutine read_integer_2Darray + +!=============================================================================== +! WRITE_INTEGER_3DARRAY writes integer precision 3-D array data +!=============================================================================== + + subroutine write_integer_3Darray(buffer, name, group, length, collect) + + integer, intent(in) :: length(3) ! length of each dimension + integer, intent(in) :: buffer(length(1),length(2),length(3)) + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if + +#ifdef HDF5 + ! Check if HDF5 group should be created/opened + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif +# ifdef MPI + ! Write the data using parallel routines + call hdf5_write_integer_3Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else + ! Write the data in serial + call hdf5_write_integer_3Darray(temp_group, name, buffer, length) +# endif + ! Check if HDF5 group should be closed + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_write_integer_3Darray(mpi_fh, buffer, length, collect_) +#else + write(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3)) #endif end subroutine write_integer_3Darray !=============================================================================== -! WRITE_LONG writes long integer scalar data +! READ_INTEGER_3DARRAY reads integer precision 3-D array data !=============================================================================== - subroutine write_long(buffer, name, group) + subroutine read_integer_3Darray(buffer, name, group, length, collect) - integer(8), intent(in) :: buffer ! data to write - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name + integer, intent(in) :: length(3) ! length of each dimension + integer, intent(inout) :: buffer(length(1),length(2),length(3)) + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -602,14 +947,156 @@ contains else temp_group = hdf5_fh endif - - ! Write the data - call hdf5_write_long(temp_group, name, buffer, hdf5_integer8_t) - +# ifdef MPI + ! Read the data using parallel routines + call hdf5_read_integer_3Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else + ! Read the data in serial + call hdf5_read_integer_3Darray(temp_group, name, buffer, length) +# endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI - call mpi_write_long(mpi_fh, buffer) + call mpi_read_integer_3Darray(mpi_fh, buffer, length, collect_) +#else + read(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3)) +#endif + + end subroutine read_integer_3Darray + +!=============================================================================== +! WRITE_INTEGER_4DARRAY writes integer precision 4-D array data +!=============================================================================== + + subroutine write_integer_4Darray(buffer, name, group, length, collect) + + integer, intent(in) :: length(4) ! length of each dimension + integer, intent(in) :: buffer(length(1),length(2),& + length(3),length(4)) + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if + +#ifdef HDF5 + ! Check if HDF5 group should be created/opened + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif +# ifdef MPI + ! Write the data using parallel routines + call hdf5_write_integer_4Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else + ! Write the data in serial + call hdf5_write_integer_4Darray(temp_group, name, buffer, length) +# endif + ! Check if HDF5 group should be closed + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_write_integer_4Darray(mpi_fh, buffer, length, collect_) +#else + write(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3), & + 1:length(4)) +#endif + + end subroutine write_integer_4Darray + +!=============================================================================== +! READ_INTEGER_4DARRAY reads integer precision 4-D array data +!=============================================================================== + + subroutine read_integer_4Darray(buffer, name, group, length, collect) + + integer, intent(in) :: length(4) ! length of each dimension + integer, intent(inout) :: buffer(length(1),length(2),& + length(3),length(4)) + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + logical :: collect_ + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if + +#ifdef HDF5 + ! Check if HDF5 group should be created/opened + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif +# ifdef MPI + ! Read the data using parallel routines + call hdf5_read_integer_4Darray_parallel(temp_group, name, buffer, length, & + collect_) +# else + ! Read the data in serial + call hdf5_read_integer_4Darray(temp_group, name, buffer, length) +# endif + ! Check if HDF5 group should be closed + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_read_integer_4Darray(mpi_fh, buffer, length, collect_) +#else + read(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3), & + 1:length(4)) +#endif + + end subroutine read_integer_4Darray + +!=============================================================================== +! WRITE_LONG writes long integer scalar data +!=============================================================================== + + subroutine write_long(buffer, name, group, collect) + + integer(8), intent(in) :: buffer ! data to write + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if + +#ifdef HDF5 + ! Check if HDF5 group should be created/opened + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif +# ifdef MPI + ! Write the data using parallel routine + call hdf5_write_long_parallel(temp_group, name, buffer, collect_) +# else + ! Write the data + call hdf5_write_long(temp_group, name, buffer) +# endif + ! Check if HDF5 group should be closed + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_write_long(mpi_fh, buffer, collect_) #else write(UNIT_OUTPUT) buffer #endif @@ -620,12 +1107,19 @@ contains ! READ_LONG reads long integer scalar data !=============================================================================== - subroutine read_long(buffer, name, group, option) + subroutine read_long(buffer, name, group, collect) - integer(8), intent(inout) :: buffer ! read data to here - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - character(*), intent(in), optional :: option ! read option + integer(8), intent(inout) :: buffer ! data to write + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -635,29 +1129,18 @@ contains temp_group = hdf5_fh endif # ifdef MPI - ! Check for option for reading default is independent - if (present(option)) then - if (option == 'collective') then - call hdf5_parallel_read_long(temp_group, name, buffer, & - hdf5_integer8_t, H5FD_MPIO_COLLECTIVE_F) - else - call hdf5_parallel_read_long(temp_group, name, buffer, & - hdf5_integer8_t, H5FD_MPIO_INDEPENDENT_F) - end if - else - ! Standard read call - call hdf5_read_long(temp_group, name, buffer, hdf5_integer8_t) - end if + ! Read the data using parallel routine + call hdf5_read_long_parallel(temp_group, name, buffer, collect_) # else - ! Read the data serial - call hdf5_read_long(temp_group, name, buffer, hdf5_integer8_t) + ! Read the data + call hdf5_read_long(temp_group, name, buffer) # endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI - call mpi_read_long(mpi_fh, buffer) + call mpi_read_long(mpi_fh, buffer, collect_) #else - read(UNIT_OUTPUT) buffer + write(UNIT_OUTPUT) buffer #endif end subroutine read_long @@ -666,17 +1149,25 @@ contains ! WRITE_STRING writes string data !=============================================================================== - subroutine write_string(buffer, name, group) + subroutine write_string(buffer, name, group, collect) - character(*), intent(in) :: buffer ! data to write - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name + character(*), intent(in) :: buffer ! data to write + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O -#ifndef HDF5 -# ifdef MPI - integer :: n ! length of string buffer to write -# endif -#endif + integer :: n + logical :: collect_ + + ! Get string length + n = len_trim(buffer) + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -685,18 +1176,17 @@ contains else temp_group = hdf5_fh endif - +# ifdef MPI + ! Write the data using parallel routine + call hdf5_write_string_parallel(temp_group, name, buffer, n, collect_) +# else ! Write the data - call hdf5_write_string(temp_group, name, buffer, len(buffer)) - - ! Check if HDf5 group should be closed + call hdf5_write_string(temp_group, name, n, buffer) +# endif + ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI - ! Length of string buffer to write - n = len(buffer) - - ! Write the data - call mpi_write_string(mpi_fh, buffer, n) + call mpi_write_string(mpi_fh, buffer, n, collect_) #else write(UNIT_OUTPUT) buffer #endif @@ -707,17 +1197,25 @@ contains ! READ_STRING reads string data !=============================================================================== - subroutine read_string(buffer, name, group, option) + subroutine read_string(buffer, name, group, collect) - character(*), intent(inout) :: buffer ! read data to here - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - character(*), intent(in), optional :: option ! read option + character(*), intent(in) :: buffer ! data to write + character(*), intent(inout) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name + logical, intent(in), optional :: collect ! collective I/O - integer :: n ! length of string to read to + integer :: n + logical :: collect_ - ! Length of string buffer to read - n = len(buffer) + ! Get string length + n = len_trim(buffer) + + ! Set up collective vs. independent I/O + if (present(collect)) then + collect_ = collect + else + collect_ = .true. + end if #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -727,31 +1225,18 @@ contains temp_group = hdf5_fh endif # ifdef MPI - ! Check for option for reading default is independent - if (present(option)) then - if (option == 'collective') then - call hdf5_parallel_read_string(temp_group, name, buffer, n, & - H5FD_MPIO_COLLECTIVE_F) - else - call hdf5_parallel_read_string(temp_group, name, buffer, n, & - H5FD_MPIO_INDEPENDENT_F) - end if - else - ! Standard read call - call hdf5_read_string(temp_group, name, buffer) - end if + ! Read the data using parallel routine + call hdf5_read_string_parallel(temp_group, name, buffer, n, collect_) # else - ! Read the data serial - call hdf5_read_string(temp_group, name, buffer) + ! Read the data + call hdf5_read_string(temp_group, name, n, buffer) # endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI - - ! Read the data - call mpi_read_string(mpi_fh, buffer, n) + call mpi_read_string(mpi_fh, buffer, n, collect_) #else - read(UNIT_OUTPUT) buffer + write(UNIT_OUTPUT) buffer #endif end subroutine read_string From 144df4e87452f868968b91bfabd97c71d0e477b3 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 30 Jul 2013 22:31:58 -0400 Subject: [PATCH 02/21] in read string should check length of full string since it is empty --- src/output_interface.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 8806a8a060..ab8b47d873 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -1208,7 +1208,7 @@ contains logical :: collect_ ! Get string length - n = len_trim(buffer) + n = len(buffer) ! Set up collective vs. independent I/O if (present(collect)) then From 07bbfe3cc45af4e3094c9a8d41bf01a6ff73327a Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 30 Jul 2013 22:32:14 -0400 Subject: [PATCH 03/21] updated hdf5 interface with parallel routines complete --- src/hdf5_interface.F90 | 856 +++++++++++++++++++++++------------------ 1 file changed, 478 insertions(+), 378 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 8cfdcd8d3d..20148f5221 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -23,6 +23,7 @@ module hdf5_interface integer(HSIZE_T) :: dims1(1) ! dims type for 1-D array integer(HSIZE_T) :: dims2(2) ! dims type for 2-D array integer(HSIZE_T) :: dims3(3) ! dims type for 3-D array + integer(HSIZE_T) :: dims4(4) ! dims type for 4-D array type(c_ptr) :: f_ptr ! pointer to data ! Generic HDF5 write procedure interface @@ -39,6 +40,7 @@ module hdf5_interface module procedure hdf5_write_integer_4Darray module procedure hdf5_write_long module procedure hdf5_write_string +#ifdef MPI module procedure hdf5_write_double_parallel module procedure hdf5_write_double_1Darray_parallel module procedure hdf5_write_double_2Darray_parallel @@ -51,6 +53,7 @@ module hdf5_interface module procedure hdf5_write_integer_4Darray_parallel module procedure hdf5_write_long_parallel module procedure hdf5_write_string_parallel +#endif end interface hdf5_write_data ! Generic HDF5 read procedure interface @@ -67,6 +70,7 @@ module hdf5_interface module procedure hdf5_read_integer_4Darray module procedure hdf5_read_long module procedure hdf5_read_string +#ifdef MPI module procedure hdf5_read_double_parallel module procedure hdf5_read_double_1Darray_parallel module procedure hdf5_read_double_2Darray_parallel @@ -79,6 +83,7 @@ module hdf5_interface module procedure hdf5_read_integer_4Darray_parallel module procedure hdf5_read_long_parallel module procedure hdf5_read_string_parallel +#endif end interface hdf5_read_data contains @@ -447,7 +452,7 @@ contains end subroutine hdf5_write_double !=============================================================================== -! HDF5_READ_DOUBLE reads integer scalar data +! HDF5_READ_DOUBLE reads double scalar data !=============================================================================== subroutine hdf5_read_double(group, name, buffer) @@ -456,7 +461,7 @@ contains character(*), intent(in) :: name ! name of data real(8), intent(inout) :: buffer ! read data to here - integer :: buffer_copy(1) ! need an array for read + real(8) :: buffer_copy(1) ! need an array for read ! Set up dimensions dims1(1) = 1 @@ -468,19 +473,19 @@ contains end subroutine hdf5_read_double !=============================================================================== -! HDF5_WRITE_DOUBLE_1DARRAY writes integer 1-D array +! HDF5_WRITE_DOUBLE_1DARRAY writes double 1-D array !=============================================================================== - subroutine hdf5_write_double_1Darray(group, name, buffer, len) + subroutine hdf5_write_double_1Darray(group, name, buffer, length) - real(8), intent(in) :: len ! length of array to write + integer, intent(in) :: length ! length of array to write integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(in) :: buffer(:) ! data to write ! Set rank and dimensions of data hdf5_rank = 1 - dims1(1) = len + dims1(1) = length ! Write data call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & @@ -489,7 +494,7 @@ contains end subroutine hdf5_write_double_1Darray !=============================================================================== -! HDF5_READ_DOUBLE_1DARRAY reads integer 1-D array +! HDF5_READ_DOUBLE_1DARRAY reads double 1-D array !=============================================================================== subroutine hdf5_read_double_1Darray(group, name, buffer, length) @@ -497,7 +502,7 @@ contains integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(inout) :: buffer(:) ! read data to here - real(8), intent(in) :: length ! length of array + integer, intent(in) :: length ! length of array ! Set dimensions dims1(1) = length @@ -508,12 +513,12 @@ contains end subroutine hdf5_read_double_1Darray !=============================================================================== -! HDF5_WRITE_DOUBLE_2DARRAY writes integer 2-D array +! HDF5_WRITE_DOUBLE_2DARRAY writes double 2-D array !=============================================================================== subroutine hdf5_write_double_2Darray(group, name, buffer, length) - real(8), intent(in) :: length(2) ! length of array dimensions + integer, intent(in) :: length(2) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(in) :: buffer(length(1),length(2)) ! data to write @@ -529,12 +534,12 @@ contains end subroutine hdf5_write_double_2Darray !=============================================================================== -! HDF5_READ_DOUBLE_2DARRAY reads integer 2-D array +! HDF5_READ_DOUBLE_2DARRAY reads double 2-D array !=============================================================================== - subroutine hdf5_write_double_2Darray(group, name, buffer, length) + subroutine hdf5_read_double_2Darray(group, name, buffer, length) - real(8), intent(in) :: length(2) ! length of array dimensions + integer, intent(in) :: length(2) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(inout) :: buffer(length(1),length(2)) ! data to read @@ -548,12 +553,12 @@ contains end subroutine hdf5_read_double_2Darray !=============================================================================== -! HDF5_WRITE_DOUBLE_3DARRAY writes integer 3-D array +! HDF5_WRITE_DOUBLE_3DARRAY writes double 3-D array !=============================================================================== subroutine hdf5_write_double_3Darray(group, name, buffer, length) - real(8), intent(in) :: length(3) ! length of array dimensions + integer, intent(in) :: length(3) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(in) :: buffer(length(1),length(2), & @@ -570,12 +575,12 @@ contains end subroutine hdf5_write_double_3Darray !=============================================================================== -! HDF5_READ_DOUBLE_3DARRAY reads integer 3-D array +! HDF5_READ_DOUBLE_3DARRAY reads double 3-D array !=============================================================================== subroutine hdf5_read_double_3Darray(group, name, buffer, length) - real(8), intent(in) :: length(3) ! length of array dimensions + integer, intent(in) :: length(3) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(inout) :: buffer(length(1),length(2), & @@ -590,12 +595,12 @@ contains end subroutine hdf5_read_double_3Darray !=============================================================================== -! HDF5_WRITE_DOUBLE_4DARRAY writes integer 4-D array +! HDF5_WRITE_DOUBLE_4DARRAY writes double 4-D array !=============================================================================== subroutine hdf5_write_double_4Darray(group, name, buffer, length) - real(8), intent(in) :: length(4) ! length of array dimensions + integer, intent(in) :: length(4) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(in) :: buffer(length(1),length(2), & @@ -612,12 +617,12 @@ contains end subroutine hdf5_write_double_4Darray !=============================================================================== -! HDF5_READ_DOUBLE_4DARRAY reads integer 4-D array +! HDF5_READ_DOUBLE_4DARRAY reads double 4-D array !=============================================================================== subroutine hdf5_read_double_4Darray(group, name, buffer, length) - real(8), intent(in) :: length(4) ! length of array dimensions + integer, intent(in) :: length(4) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(inout) :: buffer(length(1),length(2), & @@ -739,13 +744,43 @@ contains ! HDF5_READ_STRING reads string data !=============================================================================== - subroutine hdf5_read_string(group, name, buffer) + subroutine hdf5_read_string(group, name, buffer, length) integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data character(*), intent(inout) :: buffer ! read data to here + integer, intent(in) :: length ! length of string to read - call h5ltread_dataset_string_f(group, name, buffer, hdf5_err) + character(len=length), dimension(1) :: str_tmp + + ! Fortran 2003 implementation not compatible with IBM Feb 2013 compiler +! type(c_ptr), dimension(1), target :: buf_ptr +! character(len=length, kind=c_char), pointer :: chr_ptr +! f_ptr = c_loc(buf_ptr(1)) +! call h5dread_f(dset, H5T_STRING, f_ptr, hdf5_err, xfer_prp=plist) +! call c_f_pointer(buf_ptr(1), chr_ptr) +! buffer = chr_ptr +! nullify(chr_ptr) + + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) + + ! Get dataspace to read + call h5dget_space_f(dset, dspace, hdf5_err) + + ! Set dimensions + dims2 = (/length, 1/) + dims1(1) = length + + ! Read in the data + call h5dread_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, & + mem_space_id=dspace, xfer_prp = plist) + + ! Copy over buffer + buffer = str_tmp(1) + + ! Close dataset + call h5dclose_f(dset, hdf5_err) end subroutine hdf5_read_string @@ -765,215 +800,6 @@ contains end subroutine hdf5_write_attribute_string # ifdef MPI -!=============================================================================== -! HDF5_PARALLEL_READ_INTEGER reads interger scalar data in parallel -!=============================================================================== - - subroutine hdf5_parallel_read_integer(group, name, buffer, p_type) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, target, intent(inout) :: buffer ! read data to here - integer, intent(in) :: p_type ! independent or collective I/O - - ! Set up dimension - dims1(1) = 1 - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - call h5pset_dxpl_mpio_f(plist, p_type, hdf5_err) - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_parallel_read_integer - -!=============================================================================== -! HDF5_PARALLEL_READ_INTEGER_1DARRAY reads integer 1-D array in parallel -!=============================================================================== - - subroutine hdf5_parallel_read_integer_1Darray(group, name, buffer, length, & - p_type) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, intent(in) :: length ! length of array - integer, target, intent(inout) :: buffer(length) ! read data to here - integer, intent(in) :: p_type ! independent or collective I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - call h5pset_dxpl_mpio_f(plist, p_type, hdf5_err) - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer(1)) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_parallel_read_integer_1Darray - - -!=============================================================================== -! HDF5_PARALLEL_READ_LONG read long integer scalar data in parallel -!=============================================================================== - - subroutine hdf5_parallel_read_long(group, name, buffer, long_type, p_type) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer(8), target, intent(out) :: buffer ! read data to here - integer(HID_T), intent(in) :: long_type ! long integer type - integer, intent(in) :: p_type ! independent or collective I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - call h5pset_dxpl_mpio_f(plist, p_type, hdf5_err) - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, long_type, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_parallel_read_long - -!=============================================================================== -! HDF5_PARALLEL_READ_DOUBLE reads double precision scalar data in parallel -!=============================================================================== - - subroutine hdf5_parallel_read_double(group, name, buffer, p_type) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), target, intent(inout) :: buffer ! read data to here - integer, intent(in) :: p_type ! independent or collective I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - call h5pset_dxpl_mpio_f(plist, p_type, hdf5_err) - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_parallel_read_double - -!=============================================================================== -! HDF5_PARLLEL_READ_DOUBLE_1DARRAY reads double precision 1-D array in parallel -!=============================================================================== - - subroutine hdf5_parallel_read_double_1Darray(group, name, buffer, length, & - p_type) - - integer(HID_T), intent(in) :: group ! name of group - integer, intent(in) :: length ! length of array - integer, intent(in) :: p_type ! indepedent or collective I/O - character(*), intent(in) :: name ! name of data - real(8), target, intent(inout) :: buffer(length) ! read data to here - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - call h5pset_dxpl_mpio_f(plist, p_type, hdf5_err) - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer(1)) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_parallel_read_double_1Darray - -!=============================================================================== -! HDF5_PARALLEL_READ_STRING reads string data -!=============================================================================== - - subroutine hdf5_parallel_read_string(group, name, buffer, length, p_type) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - character(*), target, intent(inout) :: buffer ! read data to here - integer, intent(in) :: p_type ! independent or collective IO - integer, intent(in) :: length ! length of string - - character(len=length), dimension(1) :: str_tmp - ! Fortran 2003 implementation not compatible with IBM Feb 2013 compiler -! type(c_ptr), dimension(1), target :: buf_ptr -! character(len=length, kind=c_char), pointer :: chr_ptr -! f_ptr = c_loc(buf_ptr(1)) -! call h5dread_f(dset, H5T_STRING, f_ptr, hdf5_err, xfer_prp=plist) -! call c_f_pointer(buf_ptr(1), chr_ptr) -! buffer = chr_ptr -! nullify(chr_ptr) - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - call h5pset_dxpl_mpio_f(plist, p_type, hdf5_err) - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Get dataspace to read - call h5dget_space_f(dset, dspace, hdf5_err) - - ! Set dimensions - dims2 = (/length, 1/) - dims1(1) = length - - ! Read in the data - call h5dread_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, & - mem_space_id=dspace, xfer_prp = plist) - - ! Copy over buffer - buffer = str_tmp(1) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_parallel_read_string !=============================================================================== ! HDF5_WRITE_INTEGER_PARALLEL writes integer scalar data in parallel @@ -995,9 +821,9 @@ contains ! Set independent or collective option if (collect) then - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) else - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) end if ! Create dataspace @@ -1033,9 +859,9 @@ contains ! Set independent or collective option if (collect) then - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) else - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) end if ! Open dataset @@ -1073,9 +899,9 @@ contains ! Set independent or collective option if (collect) then - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) else - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) end if ! Create dataspace @@ -1102,20 +928,20 @@ contains subroutine hdf5_read_integer_1Darray_parallel(group, name, buffer, length, & collect) - integer, intent(in) :: length ! length of array - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, target, intent(inout) :: buffer ! read data to here - logical, intent(in) :: collect ! collective I/O + integer, intent(in) :: length ! length of array + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, target, intent(inout) :: buffer(:) ! read data to here + logical, intent(in) :: collect ! collective I/O ! Create property list for independent or collective read call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) ! Set independent or collective option if (collect) then - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) else - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) end if ! Open dataset @@ -1153,9 +979,9 @@ contains ! Set independent or collective option if (collect) then - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) else - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) end if ! Create dataspace @@ -1193,9 +1019,9 @@ contains ! Set independent or collective option if (collect) then - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) else - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) end if ! Open dataset @@ -1234,9 +1060,9 @@ contains ! Set independent or collective option if (collect) then - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) else - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) end if ! Create dataspace @@ -1275,9 +1101,9 @@ contains ! Set independent or collective option if (collect) then - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) else - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) end if ! Open dataset @@ -1316,9 +1142,9 @@ contains ! Set independent or collective option if (collect) then - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) else - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) end if ! Create dataspace @@ -1357,9 +1183,9 @@ contains ! Set independent or collective option if (collect) then - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_COLLECTIVE, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) else - call h5pset_dxpl_mpio_f(plist, H5D_MPIO_INDEPENDENT, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) end if ! Open dataset @@ -1376,273 +1202,494 @@ contains end subroutine hdf5_read_integer_4Darray_parallel !=============================================================================== -! HDF5_WRITE_DOUBLE writes integer scalar data +! HDF5_WRITE_DOUBLE_PARALLEL writes double scalar data in parallel !=============================================================================== - subroutine hdf5_write_double(group, name, buffer) + subroutine hdf5_write_double_parallel(group, name, buffer, collect) - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer ! data to write + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(in) :: buffer ! data to write + logical, intent(in) :: collect ! collect I/O ! Set rank and dimensions hdf5_rank = 1 dims1(1) = 1 - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & - (/ buffer /), hdf5_err) + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - end subroutine hdf5_write_double + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if + + ! Create dataspace + call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) + + ! Write data + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_write_double_parallel !=============================================================================== -! HDF5_READ_DOUBLE reads integer scalar data +! HDF5_READ_DOUBLE_PARALLEL reads double scalar data !=============================================================================== - subroutine hdf5_read_double(group, name, buffer) + subroutine hdf5_read_double_parallel(group, name, buffer, collect) - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer ! read data to here + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), target, intent(inout) :: buffer ! read data to here + logical, intent(in) :: collect ! collective I/O - integer :: buffer_copy(1) ! need an array for read + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - ! Set up dimensions - dims1(1) = 1 + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if + + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) ! Read data - call h5ltread_dataset_double_f(group, name, buffer_copy, dims1, hdf5_err) - buffer = buffer_copy(1) + f_ptr = c_loc(buffer) + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - end subroutine hdf5_read_double + ! Close dataset and property list + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_read_double_parallel !=============================================================================== -! HDF5_WRITE_DOUBLE_1DARRAY writes integer 1-D array +! HDF5_WRITE_DOUBLE_1DARRAY_PARALLEL writes double 1-D array in parallel !=============================================================================== - subroutine hdf5_write_double_1Darray(group, name, buffer, len) + subroutine hdf5_write_double_1Darray_parallel(group, name, buffer, length, & + collect) - real(8), intent(in) :: len ! length of array to write + integer, intent(in) :: length ! length of array to write integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(in) :: buffer(:) ! data to write + logical, intent(in) :: collect ! collect I/O ! Set rank and dimensions of data hdf5_rank = 1 - dims1(1) = len - - ! Write data - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & - buffer, hdf5_err) - - end subroutine hdf5_write_double_1Darray - -!=============================================================================== -! HDF5_READ_DOUBLE_1DARRAY reads integer 1-D array -!=============================================================================== - - subroutine hdf5_read_double_1Darray(group, name, buffer, length) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer(:) ! read data to here - real(8), intent(in) :: length ! length of array - - ! Set dimensions dims1(1) = length + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if + + ! Create dataspace + call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) + + ! Write data + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_write_double_1Darray_parallel + +!=============================================================================== +! HDF5_WRITE_DOUBLE_1DARRAY_PARALLEL reads double 1-D array in parallel +!=============================================================================== + + subroutine hdf5_read_double_1Darray_parallel(group, name, buffer, length, & + collect) + + integer, intent(in) :: length ! length of array + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + real(8), intent(inout) :: buffer(:) ! read data to here + logical, intent(in) :: collect ! collective I/O + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if + + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) + ! Read data - call h5ltread_dataset_double_f(group, name, buffer, dims1, hdf5_err) + f_ptr = c_loc(buffer) + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - end subroutine hdf5_read_double_1Darray + ! Close dataset and property list + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_read_double_1Darray_parallel !=============================================================================== -! HDF5_WRITE_DOUBLE_2DARRAY writes integer 2-D array +! HDF5_WRITE_DOUBLE_2DARRAY_PARALLEL writes double 2-D array in parallel !=============================================================================== - subroutine hdf5_write_double_2Darray(group, name, buffer, length) + subroutine hdf5_write_double_2Darray_parallel(group, name, buffer, length, & + collect) - real(8), intent(in) :: length(2) ! length of array dimensions + integer, intent(in) :: length(2) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(in) :: buffer(length(1),length(2)) ! data to write + logical, intent(in) :: collect ! collective I/O ! Set rank and dimensions hdf5_rank = 2 dims2 = length + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if + + ! Create dataspace + call h5screate_simple_f(hdf5_rank, dims2, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) + ! Write data - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims2, & - buffer, hdf5_err) + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - end subroutine hdf5_write_double_2Darray + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_write_double_2Darray_parallel !=============================================================================== -! HDF5_READ_DOUBLE_2DARRAY reads integer 2-D array +! HDF5_READ_DOUBLE_2DARRAY_PARALLEL reads double 2-D array in parallel !=============================================================================== - subroutine hdf5_write_double_2Darray(group, name, buffer, length) + subroutine hdf5_read_double_2Darray_parallel(group, name, buffer, length, & + collect) - real(8), intent(in) :: length(2) ! length of array dimensions + integer, intent(in) :: length(2) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(inout) :: buffer(length(1),length(2)) ! data to read + logical, intent(in) :: collect ! collect I/O - ! Set rank and dimensions - dims2 = length + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - ! Write data - call h5ltread_dataset_double_f(group, name, buffer, dims2, hdf5_err) + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if - end subroutine hdf5_read_double_2Darray + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) + + ! Read data + f_ptr = c_loc(buffer) + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close dataset and property list + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_read_double_2Darray_parallel !=============================================================================== -! HDF5_WRITE_DOUBLE_3DARRAY writes integer 3-D array +! HDF5_WRITE_DOUBLE_3DARRAY_PARALLEL writes double 3-D array in parallel !=============================================================================== - subroutine hdf5_write_double_3Darray(group, name, buffer, length) + subroutine hdf5_write_double_3Darray_parallel(group, name, buffer, length, & + collect) - real(8), intent(in) :: length(3) ! length of array dimensions + integer, intent(in) :: length(3) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(in) :: buffer(length(1),length(2), & length(3)) ! data to write + logical, intent(in) :: collect ! collective I/O ! Set rank and dimensions hdf5_rank = 3 dims3 = length + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if + + ! Create dataspace + call h5screate_simple_f(hdf5_rank, dims3, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) + ! Write data - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims3, & - buffer, hdf5_err) + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - end subroutine hdf5_write_double_3Darray + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_write_double_3Darray_parallel !=============================================================================== -! HDF5_READ_DOUBLE_3DARRAY reads integer 3-D array +! HDF5_READ_DOUBLE_3DARRAY_PARALLEL reads double 3-D array in parallel !=============================================================================== - subroutine hdf5_read_double_3Darray(group, name, buffer, length) + subroutine hdf5_read_double_3Darray_parallel(group, name, buffer, length, & + collect) - real(8), intent(in) :: length(3) ! length of array dimensions + integer, intent(in) :: length(3) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(inout) :: buffer(length(1),length(2), & length(3)) ! data to read + logical, intent(in) :: collect ! collective I/O - ! Set rank and dimensions - dims3 = length + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - ! Write data - call h5ltread_dataset_double_f(group, name, buffer, dims3, hdf5_err) + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if - end subroutine hdf5_read_double_3Darray + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) + + ! Read data + f_ptr = c_loc(buffer) + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close dataset and property list + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_read_double_3Darray_parallel !=============================================================================== -! HDF5_WRITE_DOUBLE_4DARRAY writes integer 4-D array +! HDF5_WRITE_DOUBLE_4DARRAY_PARALLEL writes double 4-D array in parallel !=============================================================================== - subroutine hdf5_write_double_4Darray(group, name, buffer, length) + subroutine hdf5_write_double_4Darray_parallel(group, name, buffer, length, & + collect) - real(8), intent(in) :: length(4) ! length of array dimensions + integer, intent(in) :: length(4) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(in) :: buffer(length(1),length(2), & length(3),length(4)) ! data to write + logical, intent(in) :: collect ! collective I/O ! Set rank and dimensions hdf5_rank = 4 dims4 = length + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if + + ! Create dataspace + call h5screate_simple_f(hdf5_rank, dims4, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) + ! Write data - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims4, & - buffer, hdf5_err) + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - end subroutine hdf5_write_double_4Darray + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_write_double_4Darray_parallel !=============================================================================== -! HDF5_READ_DOUBLE_4DARRAY reads integer 4-D array +! HDF5_READ_DOUBLE_4DARRAY_PARALLEL reads double 4-D array in parallel !=============================================================================== - subroutine hdf5_read_double_4Darray(group, name, buffer, length) + subroutine hdf5_read_double_4Darray_parallel(group, name, buffer, length, & + collect) - real(8), intent(in) :: length(4) ! length of array dimensions + integer, intent(in) :: length(4) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data real(8), intent(inout) :: buffer(length(1),length(2), & length(3),length(4)) ! data to read + logical, intent(in) :: collect ! collective I/O - ! Set rank and dimensions - dims4 = length + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - ! Write data - call h5ltread_dataset_double_f(group, name, buffer, dims4, hdf5_err) + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if - end subroutine hdf5_read_double_4Darray + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) + + ! Read data + f_ptr = c_loc(buffer) + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + + ! Close dataset and property list + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_read_double_4Darray_parallel !=============================================================================== -! HDF5_WRITE_LONG writes long integer scalar data +! HDF5_WRITE_LONG_PARALLEL writes long integer scalar data in parallel !=============================================================================== - subroutine hdf5_write_long(group, name, buffer, long_type) + subroutine hdf5_write_long_parallel(group, name, buffer, long_type, collect) integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data integer(8), target, intent(in) :: buffer ! data to write integer(HID_T), intent(in) :: long_type ! HDF5 long type + logical, intent(in) :: collect ! collective I/O ! Set up rank and dimensions hdf5_rank = 1 dims1(1) = 1 - ! Create dataspace and dataset + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if + + ! Create dataspace call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) - call h5dcreate_f(group, name, long_type, dspace, dset, hdf5_err) - ! Write eight-byte integer + ! Create dataset + call h5dcreate_f(hdf5_fh, name, long_type, dspace, dset, hdf5_err) + + ! Write data f_ptr = c_loc(buffer) - call h5dwrite_f(dset, long_type, f_ptr, hdf5_err) + call h5dwrite_f(dset, long_type, f_ptr, hdf5_err, xfer_prp=plist) - ! Close dataspace and dataset for long integer + ! Close all call h5dclose_f(dset, hdf5_err) call h5sclose_f(dspace, hdf5_err) + call h5pclose_f(plist, hdf5_err) - end subroutine hdf5_write_long + end subroutine hdf5_write_long_parallel !=============================================================================== -! HDF5_READ_LONG read long integer scalar data +! HDF5_READ_LONG_PARALLEL read long integer scalar data in parallel !=============================================================================== - subroutine hdf5_read_long(group, name, buffer, long_type) + subroutine hdf5_read_long_parallel(group, name, buffer, long_type, collect) - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer(8), target, intent(out) :: buffer ! read data to here - integer(HID_T), intent(in) :: long_type ! long integer type + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer(8), intent(out) :: buffer ! read data to here + integer(HID_T), intent(in) :: long_type ! long integer type + logical, intent(in) :: collect ! collective I/O + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if ! Open dataset call h5dopen_f(group, name, dset, hdf5_err) - ! Get pointer to buffer + ! Read data f_ptr = c_loc(buffer) + call h5dread_f(dset, long_type, f_ptr, hdf5_err, xfer_prp=plist) - ! Read data from dataset - call h5dread_f(dset, long_type, f_ptr, hdf5_err) - - ! Close dataset + ! Close dataset and property list call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) - end subroutine hdf5_read_long + end subroutine hdf5_read_long_parallel !=============================================================================== -! HDF5_WRITE_STRING writes string data +! HDF5_WRITE_STRING_PARALLEL writes string data in parallel !=============================================================================== - subroutine hdf5_write_string(group, name, buffer, length) + subroutine hdf5_write_string_parallel(group, name, buffer, length, collect) - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - character(*), intent(in) :: buffer ! data to write - integer, intent(in) :: length + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + character(*), intent(in) :: buffer ! data to write + integer, intent(in) :: length ! length of string + logical, intent(in) :: collect ! collective I/O character(len=length), dimension(1) :: str_tmp @@ -1656,6 +1703,16 @@ contains ! wdata(1) = c_loc(c_str(1)) ! f_ptr = c_loc(wdata(1)) + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if + ! Number of strings to write dims1(1) = 1 @@ -1675,27 +1732,70 @@ contains ! Write the variable dataset call h5dwrite_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, & - mem_space_id=dspace) + mem_space_id=dspace, xfer_prp=plist) ! Close all call h5dclose_f(dset, hdf5_err) call h5sclose_f(dspace, hdf5_err) + call h5pclose_f(plist, hdf5_err) - end subroutine hdf5_write_string + end subroutine hdf5_write_string_parallel !=============================================================================== -! HDF5_READ_STRING reads string data +! HDF5_READ_STRING_PARALLEL reads string data in parallel !=============================================================================== - subroutine hdf5_read_string(group, name, buffer) + subroutine hdf5_read_string_parallel(group, name, buffer, length, collect) - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - character(*), intent(inout) :: buffer ! read data to here + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + character(*), intent(inout) :: buffer ! read data to here + integer, intent(in) :: length ! length of string + logical, intent(in) :: collect ! collective I/O - call h5ltread_dataset_string_f(group, name, buffer, hdf5_err) + character(len=length), dimension(1) :: str_tmp - end subroutine hdf5_read_string + ! Fortran 2003 implementation not compatible with IBM Feb 2013 compiler +! type(c_ptr), dimension(1), target :: buf_ptr +! character(len=length, kind=c_char), pointer :: chr_ptr +! f_ptr = c_loc(buf_ptr(1)) +! call h5dread_f(dset, H5T_STRING, f_ptr, hdf5_err, xfer_prp=plist) +! call c_f_pointer(buf_ptr(1), chr_ptr) +! buffer = chr_ptr +! nullify(chr_ptr) + + ! Create property list for independent or collective read + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + + ! Set independent or collective option + if (collect) then + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + else + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) + end if + + ! Open dataset + call h5dopen_f(group, name, dset, hdf5_err) + + ! Get dataspace to read + call h5dget_space_f(dset, dspace, hdf5_err) + + ! Set dimensions + dims2 = (/length, 1/) + dims1(1) = length + + ! Read in the data + call h5dread_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, & + mem_space_id=dspace, xfer_prp = plist) + + ! Copy over buffer + buffer = str_tmp(1) + + ! Close dataset and property list + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + end subroutine hdf5_read_string_parallel # endif From c19a3da7459f10a853885e6daa9729f917b2cd5c Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 31 Jul 2013 18:41:29 -0400 Subject: [PATCH 04/21] updated MPI I/O interface to include writing/reading more types --- src/mpiio_interface.F90 | 602 ++++++++++++++++++++++++++++++++-------- 1 file changed, 483 insertions(+), 119 deletions(-) diff --git a/src/mpiio_interface.F90 b/src/mpiio_interface.F90 index d3e9774df8..39ce91e1a1 100644 --- a/src/mpiio_interface.F90 +++ b/src/mpiio_interface.F90 @@ -8,6 +8,38 @@ module mpiio_interface integer :: mpi_fh ! MPI file handle integer :: mpiio_err ! MPI error code + ! Generic HDF5 write procedure interface + interface mpi_write_data + module procedure mpi_write_double + module procedure mpi_write_double_1Darray + module procedure mpi_write_double_2Darray + module procedure mpi_write_double_3Darray + module procedure mpi_write_double_4Darray + module procedure mpi_write_integer + module procedure mpi_write_integer_1Darray + module procedure mpi_write_integer_2Darray + module procedure mpi_write_integer_3Darray + module procedure mpi_write_integer_4Darray + module procedure mpi_write_long + module procedure mpi_write_string + end interface mpi_write_data + + ! Generic HDF5 read procedure interface + interface mpi_read_data + module procedure mpi_read_double + module procedure mpi_read_double_1Darray + module procedure mpi_read_double_2Darray + module procedure mpi_read_double_3Darray + module procedure mpi_read_double_4Darray + module procedure mpi_read_integer + module procedure mpi_read_integer_1Darray + module procedure mpi_read_integer_2Darray + module procedure mpi_read_integer_3Darray + module procedure mpi_read_integer_4Darray + module procedure mpi_read_long + module procedure mpi_read_string + end interface mpi_read_data + contains !=============================================================================== @@ -65,173 +97,505 @@ contains ! MPI_WRITE_INTEGER writes integer scalar data using MPI File I/O !=============================================================================== - subroutine mpi_write_integer(fh, buffer) + subroutine mpi_write_integer(fh, buffer, collect) - integer, intent(in) :: fh ! file handle - integer, intent(in) :: buffer ! data to write + integer, intent(in) :: fh ! file handle + integer, intent(in) :: buffer ! data to write + logical, intent(in) :: collect ! collective I/O - call MPI_FILE_WRITE(fh, buffer, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) + if (collect) then + call MPI_FILE_WRITE_ALL(fh, buffer, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_WRITE(fh, buffer, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + end if end subroutine mpi_write_integer -!=============================================================================== -! MPI_WRITE_INTEGER_1DARRAY writes integer 1-D array data using MPI File I/O -!=============================================================================== - - subroutine mpi_write_integer_1Darray(fh, buffer, length) - - integer, intent(in) :: fh ! file handle - integer, intent(in) :: length ! length of array - integer, intent(in) :: buffer(:) ! data to write - - call MPI_FILE_WRITE(fh, buffer, length, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - - end subroutine mpi_write_integer_1Darray - -!=============================================================================== -! MPI_WRITE_LONG writes long integer scalar data using MPI file I/O -!=============================================================================== - - subroutine mpi_write_long(fh, buffer) - - integer, intent(in) :: fh ! file handle - integer(8), intent(in) :: buffer ! data to write - - call MPI_FILE_WRITE(fh, buffer, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpiio_err) - - end subroutine mpi_write_long - -!=============================================================================== -! MPI_WRITE_DOUBLE writes double precision scalar data using MPI file I/O -!=============================================================================== - - subroutine mpi_write_double(fh, buffer) - - integer, intent(in) :: fh ! file handle - real(8), intent(in) :: buffer ! data to write - - call MPI_FILE_WRITE(fh, buffer, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - - end subroutine mpi_write_double - -!=============================================================================== -! MPI_WRITE_DOUBLE_1DARRAY writes double precision 1-D array using MPI file I/O -!=============================================================================== - - subroutine mpi_write_double_1Darray(fh, buffer, length) - - integer, intent(in) :: fh ! file handle - integer, intent(in) :: length ! length of array - real(8), intent(in) :: buffer(:) ! data to write - - call MPI_FILE_WRITE(fh, buffer, length, MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - - end subroutine mpi_write_double_1Darray - -!=============================================================================== -! MPI_WRITE_STRING writes string data using MPI file I/O -!=============================================================================== - - subroutine mpi_write_string(fh, buffer, length) - - character(*), intent(in) :: buffer ! data to write - integer, intent(in) :: fh ! file handle - integer, intent(in) :: length ! length of data - - call MPI_FILE_WRITE(fh, buffer, length, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpiio_err) - - end subroutine mpi_write_string - !=============================================================================== ! MPI_READ_INTEGER reads integer scalar data using MPI file I/O !=============================================================================== - subroutine mpi_read_integer(fh, buffer) + subroutine mpi_read_integer(fh, buffer, collect) - integer, intent(in) :: fh ! file handle - integer, intent(inout) :: buffer ! read data to here + integer, intent(in) :: fh ! file handle + integer, intent(inout) :: buffer ! read data to here + logical, intent(in) :: collect ! collective I/O - call MPI_FILE_READ(fh, buffer, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) + if (collect) then + call MPI_FILE_READ_ALL(fh, buffer, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_READ(fh, buffer, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + end if end subroutine mpi_read_integer +!=============================================================================== +! MPI_WRITE_INTEGER_1DARRAY writes integer 1-D array data using MPI File I/O +!=============================================================================== + + subroutine mpi_write_integer_1Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length ! length of array + integer, intent(in) :: buffer(:) ! data to write + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_WRITE_ALL(fh, buffer, length, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_WRITE(fh, buffer, length, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_write_integer_1Darray + !=============================================================================== ! MPI_READ_INTEGER_1DARRAY reads integer 1-D array using MPI file I/O !=============================================================================== - subroutine mpi_read_integer_1Darray(fh, buffer, length) + subroutine mpi_read_integer_1Darray(fh, buffer, length, collect) integer, intent(in) :: fh ! file handle integer, intent(in) :: length ! length of array integer, intent(inout) :: buffer(:) ! read data to here + logical, intent(in) :: collect ! collective I/O - call MPI_FILE_READ(fh, buffer, length, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) + if (collect) then + call MPI_FILE_READ_ALL(fh, buffer, length, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_READ(fh, buffer, length, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + end if end subroutine mpi_read_integer_1Darray +!=============================================================================== +! MPI_WRITE_INTEGER_2DARRAY writes integer 2-D array data using MPI File I/O +!=============================================================================== + + subroutine mpi_write_integer_2Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length(2) ! length of array + integer, intent(in) :: buffer(length(1),length(2)) ! data to write + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_WRITE_ALL(fh, buffer, product(length), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_WRITE(fh, buffer, product(length), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_write_integer_2Darray + +!=============================================================================== +! MPI_READ_INTEGER_2DARRAY reads integer 2-D array using MPI file I/O +!=============================================================================== + + subroutine mpi_read_integer_2Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length(2) ! length of array + integer, intent(inout) :: buffer(length(1),length(2)) ! read data to here + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_READ_ALL(fh, buffer, product(length), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_READ(fh, buffer, product(length), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_read_integer_2Darray + +!=============================================================================== +! MPI_WRITE_INTEGER_3DARRAY writes integer 3-D array data using MPI File I/O +!=============================================================================== + + subroutine mpi_write_integer_3Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length(3) ! length of array + integer, intent(in) :: buffer(length(1),length(2),& + length(3)) ! data to write + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_WRITE_ALL(fh, buffer, product(length), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_WRITE(fh, buffer, product(length), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_write_integer_3Darray + +!=============================================================================== +! MPI_READ_INTEGER_3DARRAY reads integer 3-D array using MPI file I/O +!=============================================================================== + + subroutine mpi_read_integer_3Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length(3) ! length of array + integer, intent(inout) :: buffer(length(1),length(2), & + length(3)) ! read data to here + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_READ_ALL(fh, buffer, product(length), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_READ(fh, buffer, product(length), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_read_integer_3Darray + +!=============================================================================== +! MPI_WRITE_INTEGER_4DARRAY writes integer 4-D array data using MPI File I/O +!=============================================================================== + + subroutine mpi_write_integer_4Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length(4) ! length of array + integer, intent(in) :: buffer(length(1),length(2),& + length(3),length(4)) ! data to write + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_WRITE_ALL(fh, buffer, product(length), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_WRITE(fh, buffer, product(length), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_write_integer_4Darray + +!=============================================================================== +! MPI_READ_INTEGER_4DARRAY reads integer 4-D array using MPI file I/O +!=============================================================================== + + subroutine mpi_read_integer_4Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length(4) ! length of array + integer, intent(inout) :: buffer(length(1),length(2), & + length(3),length(4)) ! read data to here + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_READ_ALL(fh, buffer, product(length), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_READ(fh, buffer, product(length), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_read_integer_4Darray + +!=============================================================================== +! MPI_WRITE_DOUBLE writes integer scalar data using MPI File I/O +!=============================================================================== + + subroutine mpi_write_double(fh, buffer, collect) + + integer, intent(in) :: fh ! file handle + real(8), intent(in) :: buffer ! data to write + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_WRITE_ALL(fh, buffer, 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_WRITE(fh, buffer, 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_write_double + +!=============================================================================== +! MPI_READ_DOUBLE reads integer scalar data using MPI file I/O +!=============================================================================== + + subroutine mpi_read_double(fh, buffer, collect) + + integer, intent(in) :: fh ! file handle + real(8), intent(inout) :: buffer ! read data to here + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_READ_ALL(fh, buffer, 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_READ(fh, buffer, 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_read_double + +!=============================================================================== +! MPI_WRITE_DOUBLE_1DARRAY writes integer 1-D array data using MPI File I/O +!=============================================================================== + + subroutine mpi_write_double_1Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length ! length of array + real(8), intent(in) :: buffer(:) ! data to write + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_WRITE_ALL(fh, buffer, length, MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_WRITE(fh, buffer, length, MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_write_double_1Darray + +!=============================================================================== +! MPI_READ_DOUBLE_1DARRAY reads integer 1-D array using MPI file I/O +!=============================================================================== + + subroutine mpi_read_double_1Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length ! length of array + real(8), intent(inout) :: buffer(:) ! read data to here + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_READ_ALL(fh, buffer, length, MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_READ(fh, buffer, length, MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_read_double_1Darray + +!=============================================================================== +! MPI_WRITE_DOUBLE_2DARRAY writes integer 2-D array data using MPI File I/O +!=============================================================================== + + subroutine mpi_write_double_2Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length(2) ! length of array + real(8), intent(in) :: buffer(length(1),length(2)) ! data to write + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_WRITE_ALL(fh, buffer, product(length), MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_WRITE(fh, buffer, product(length), MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_write_double_2Darray + +!=============================================================================== +! MPI_READ_DOUBLE_2DARRAY reads integer 2-D array using MPI file I/O +!=============================================================================== + + subroutine mpi_read_double_2Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length(2) ! length of array + real(8), intent(inout) :: buffer(length(1),length(2)) ! read data to here + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_READ_ALL(fh, buffer, product(length), MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_READ(fh, buffer, product(length), MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_read_double_2Darray + +!=============================================================================== +! MPI_WRITE_DOUBLE_3DARRAY writes integer 3-D array data using MPI File I/O +!=============================================================================== + + subroutine mpi_write_double_3Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length(3) ! length of array + real(8), intent(in) :: buffer(length(1),length(2),& + length(3)) ! data to write + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_WRITE_ALL(fh, buffer, product(length), MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_WRITE(fh, buffer, product(length), MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_write_double_3Darray + +!=============================================================================== +! MPI_READ_DOUBLE_3DARRAY reads integer 3-D array using MPI file I/O +!=============================================================================== + + subroutine mpi_read_double_3Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length(3) ! length of array + real(8), intent(inout) :: buffer(length(1),length(2), & + length(3)) ! read data to here + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_READ_ALL(fh, buffer, product(length), MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_READ(fh, buffer, product(length), MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_read_double_3Darray + +!=============================================================================== +! MPI_WRITE_DOUBLE_4DARRAY writes integer 4-D array data using MPI File I/O +!=============================================================================== + + subroutine mpi_write_double_4Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length(4) ! length of array + real(8), intent(in) :: buffer(length(1),length(2),& + length(3),length(4)) ! data to write + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_WRITE_ALL(fh, buffer, product(length), MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_WRITE(fh, buffer, product(length), MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_write_double_4Darray + +!=============================================================================== +! MPI_READ_DOUBLE_4DARRAY reads integer 4-D array using MPI file I/O +!=============================================================================== + + subroutine mpi_read_double_4Darray(fh, buffer, length, collect) + + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length(4) ! length of array + real(8), intent(inout) :: buffer(length(1),length(2), & + length(3),length(4)) ! read data to here + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_READ_ALL(fh, buffer, product(length), MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_READ(fh, buffer, product(length), MPI_REAL8, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_read_double_4Darray + +!=============================================================================== +! MPI_WRITE_LONG writes long integer scalar data using MPI file I/O +!=============================================================================== + + subroutine mpi_write_long(fh, buffer, collect) + + integer, intent(in) :: fh ! file handle + integer(8), intent(in) :: buffer ! data to write + logical, intent(in) :: collect ! collective I/O + + if (collect) then + call MPI_FILE_WRITE_ALL(fh, buffer, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_WRITE(fh, buffer, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpiio_err) + end if + + end subroutine mpi_write_long + !=============================================================================== ! MPI_READ_LONG reads long integer scalar data using MPI file I/O !=============================================================================== - subroutine mpi_read_long(fh, buffer) + subroutine mpi_read_long(fh, buffer, collect) - integer, intent(in) :: fh ! file handle - integer(8), intent(inout) :: buffer ! read data to here + integer, intent(in) :: fh ! file handle + integer(8), intent(inout) :: buffer ! read data to here + logical, intent(in) :: collect ! collective I/O - call MPI_FILE_READ(fh, buffer, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpiio_err) + if (collect) then + call MPI_FILE_READ_ALL(fh, buffer, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_READ(fh, buffer, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpiio_err) + end if end subroutine mpi_read_long !=============================================================================== -! MPI_READ_DOUBLE reads double precision scalar data using MPI file I/O +! MPI_WRITE_STRING writes string data using MPI file I/O !=============================================================================== - subroutine mpi_read_double(fh, buffer) + subroutine mpi_write_string(fh, buffer, length, collect) - integer, intent(in) :: fh ! file handle - real(8), intent(inout) :: buffer ! read data to here + character(*), intent(in) :: buffer ! data to write + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length ! length of data + logical, intent(in) :: collect ! collective I/O - call MPI_FILE_READ(fh, buffer, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) + if (collect) then + call MPI_FILE_WRITE_ALL(fh, buffer, length, MPI_CHARACTER, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_WRITE(fh, buffer, length, MPI_CHARACTER, & + MPI_STATUS_IGNORE, mpiio_err) + end if - end subroutine mpi_read_double - -!=============================================================================== -! MPI_READ_DOUBLE_1DARRAY reads double precision 1-D array using MPI file I/O -!=============================================================================== - - subroutine mpi_read_double_1Darray(fh, buffer, length) - - integer, intent(in) :: fh ! file handle - integer, intent(in) :: length ! length of array - real(8), intent(inout) :: buffer(:) ! read data to here - - call MPI_FILE_READ(fh, buffer, length, MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - - end subroutine mpi_read_double_1Darray + end subroutine mpi_write_string !=============================================================================== ! MPI_READ_STRING reads string data using MPI file I/O !=============================================================================== - subroutine mpi_read_string(fh, buffer, length) + subroutine mpi_read_string(fh, buffer, length, collect) - character(*), intent(inout) :: buffer ! read data to here - integer, intent(in) :: fh ! file handle - integer, intent(in) :: length ! length of string + character(*), intent(inout) :: buffer ! read data to here + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length ! length of string + logical, intent(in) :: collect ! collective I/O - call MPI_FILE_READ(fh, buffer, length, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpiio_err) + if (collect) then + call MPI_FILE_READ_ALL(fh, buffer, length, MPI_CHARACTER, & + MPI_STATUS_IGNORE, mpiio_err) + else + call MPI_FILE_READ(fh, buffer, length, MPI_CHARACTER, & + MPI_STATUS_IGNORE, mpiio_err) + end if end subroutine mpi_read_string From 4b3786af77ebf4b955832357b4510d83d9b3b46e Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 31 Jul 2013 21:05:16 -0400 Subject: [PATCH 05/21] output interface is now a derived type with type-bound procedures, updated hdf5 and mpi I/O accordingly --- src/hdf5_interface.F90 | 40 +- src/mpiio_interface.F90 | 1 - src/output_interface.F90 | 997 ++++++++++++++++++++++++--------------- 3 files changed, 649 insertions(+), 389 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 20148f5221..ea21fd0f46 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -16,8 +16,6 @@ module hdf5_interface integer :: hdf5_rank ! rank of data integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle - integer(HID_T) :: hdf5_fh ! HDF5 file handle - integer(HID_T) :: temp_group ! temporary HDF5 group handle integer(HID_T) :: memspace ! data space handle for individual procs integer(HID_T) :: plist ! property list handle integer(HSIZE_T) :: dims1(1) ! dims type for 1-D array @@ -199,9 +197,11 @@ contains ! HDF5_OPEN_GROUP creates/opens HDF5 group to temp_group !=============================================================================== - subroutine hdf5_open_group(group) + subroutine hdf5_open_group(hdf5_fh, group, hdf5_grp) - character(*), intent(in) :: group ! name of group + character(*), intent(in) :: group ! name of group + integer(HID_T), intent(in) :: hdf5_fh ! file handle of main output file + integer(HID_T), intent(inout) :: hdf5_grp ! handle for group logical :: status ! does the group exist @@ -210,9 +210,9 @@ contains ! Either create or open group if (status) then - call h5gopen_f(hdf5_fh, trim(group), temp_group, hdf5_err) + call h5gopen_f(hdf5_fh, trim(group), hdf5_grp, hdf5_err) else - call h5gcreate_f(hdf5_fh, trim(group), temp_group, hdf5_err) + call h5gcreate_f(hdf5_fh, trim(group), hdf5_grp, hdf5_err) end if end subroutine hdf5_open_group @@ -221,10 +221,12 @@ contains ! HDF5_CLOSE_GROUP closes HDF5 temp_group !=============================================================================== - subroutine hdf5_close_group() + subroutine hdf5_close_group(hdf5_grp) + + integer(HID_T), intent(inout) :: hdf5_grp ! Close the group - call h5gclose_f(temp_group, hdf5_err) + call h5gclose_f(hdf5_grp, hdf5_err) end subroutine hdf5_close_group @@ -830,7 +832,7 @@ contains call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) ! Create dataset - call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) + call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) ! Write data f_ptr = c_loc(buffer) @@ -908,7 +910,7 @@ contains call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) ! Create dataset - call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) + call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) ! Write data f_ptr = c_loc(buffer) @@ -988,7 +990,7 @@ contains call h5screate_simple_f(hdf5_rank, dims2, dspace, hdf5_err) ! Create dataset - call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) + call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) ! Write data f_ptr = c_loc(buffer) @@ -1069,7 +1071,7 @@ contains call h5screate_simple_f(hdf5_rank, dims3, dspace, hdf5_err) ! Create dataset - call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) + call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) ! Write data f_ptr = c_loc(buffer) @@ -1151,7 +1153,7 @@ contains call h5screate_simple_f(hdf5_rank, dims4, dspace, hdf5_err) ! Create dataset - call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) + call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) ! Write data f_ptr = c_loc(buffer) @@ -1230,7 +1232,7 @@ contains call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) ! Create dataset - call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) + call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) ! Write data f_ptr = c_loc(buffer) @@ -1308,7 +1310,7 @@ contains call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) ! Create dataset - call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) + call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) ! Write data f_ptr = c_loc(buffer) @@ -1388,7 +1390,7 @@ contains call h5screate_simple_f(hdf5_rank, dims2, dspace, hdf5_err) ! Create dataset - call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) + call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) ! Write data f_ptr = c_loc(buffer) @@ -1469,7 +1471,7 @@ contains call h5screate_simple_f(hdf5_rank, dims3, dspace, hdf5_err) ! Create dataset - call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) + call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) ! Write data f_ptr = c_loc(buffer) @@ -1551,7 +1553,7 @@ contains call h5screate_simple_f(hdf5_rank, dims4, dspace, hdf5_err) ! Create dataset - call h5dcreate_f(hdf5_fh, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) + call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) ! Write data f_ptr = c_loc(buffer) @@ -1631,7 +1633,7 @@ contains call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) ! Create dataset - call h5dcreate_f(hdf5_fh, name, long_type, dspace, dset, hdf5_err) + call h5dcreate_f(group, name, long_type, dspace, dset, hdf5_err) ! Write data f_ptr = c_loc(buffer) diff --git a/src/mpiio_interface.F90 b/src/mpiio_interface.F90 index 39ce91e1a1..56a1207f35 100644 --- a/src/mpiio_interface.F90 +++ b/src/mpiio_interface.F90 @@ -5,7 +5,6 @@ module mpiio_interface implicit none - integer :: mpi_fh ! MPI file handle integer :: mpiio_err ! MPI error code ! Generic HDF5 write procedure interface diff --git a/src/output_interface.F90 b/src/output_interface.F90 index ab8b47d873..a5ebcfacbf 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -1,7 +1,7 @@ module output_interface use constants - use error, only: warning + use error, only: warning, fatal_error use global use tally_header, only: TallyResult @@ -12,32 +12,65 @@ module output_interface #endif implicit none + private - ! Generic write procedure interface - interface write_data - module procedure write_double - module procedure write_double_1Darray - module procedure write_double_2Darray - module procedure write_double_3Darray - module procedure write_double_4Darray - module procedure write_integer - module procedure write_integer_1Darray - module procedure write_integer_2Darray - module procedure write_integer_3Darray - module procedure write_long - module procedure write_string - end interface write_data - - ! Generic read procedure interface - interface read_data - module procedure read_double - module procedure read_double_1Darray - module procedure read_double_4Darray - module procedure read_integer - module procedure read_integer_1Darray - module procedure read_long - module procedure read_string - end interface read_data + type, public :: BinaryOutput + private + ! Compilation specific data +#ifdef HDF5 + integer(HID_T) :: hdf5_fh + integer(HID_T) :: hdf5_grp +#else + integer :: unit_fh +# endif + logical :: serial ! Serial I/O when using MPI/PHDF5 + contains + generic, public :: write_data => write_double, & + write_double_1Darray, & + write_double_2Darray, & + write_double_3Darray, & + write_double_4Darray, & + write_integer, & + write_integer_1Darray, & + write_integer_2Darray, & + write_integer_3Darray, & + write_integer_4Darray + generic, public :: read_data => read_double, & + read_double_1Darray, & + read_double_2Darray, & + read_double_3Darray, & + read_double_4Darray, & + read_integer, & + read_integer_1Darray, & + read_integer_2Darray, & + read_integer_3Darray, & + read_integer_4Darray + procedure, public :: write_double => write_double + procedure, public :: write_double_1Darray => write_double_1Darray + procedure, public :: write_double_2Darray => write_double_2Darray + procedure, public :: write_double_3Darray => write_double_3Darray + procedure, public :: write_double_4Darray => write_double_4Darray + procedure, public :: write_integer => write_integer + procedure, public :: write_integer_1Darray => write_integer_1Darray + procedure, public :: write_integer_2Darray => write_integer_2Darray + procedure, public :: write_integer_3Darray => write_integer_3Darray + procedure, public :: write_integer_4Darray => write_integer_4Darray + procedure, public :: read_double => read_double + procedure, public :: read_double_1Darray => read_double_1Darray + procedure, public :: read_double_2Darray => read_double_2Darray + procedure, public :: read_double_3Darray => read_double_3Darray + procedure, public :: read_double_4Darray => read_double_4Darray + procedure, public :: read_integer => read_double + procedure, public :: read_integer_1Darray => read_double_1Darray + procedure, public :: read_integer_2Darray => read_double_2Darray + procedure, public :: read_integer_3Darray => read_double_3Darray + procedure, public :: read_integer_4Darray => read_double_4Darray + procedure, public :: write_attribute_string => write_attribute_string + procedure, public :: write_tally_result => write_tally_result + procedure, public :: read_tally_result => read_tally_result + procedure, public :: write_source_bank => write_source_bank + procedure, public :: read_source_bank => read_source_bank + end type BinaryOutput contains @@ -45,32 +78,52 @@ contains ! FILE_CREATE creates a new file to write data to !=============================================================================== - subroutine file_create(filename, fh_str, proc_id) + subroutine file_create(self, filename, serial, unit) - character(*), intent(in) :: filename ! name of file to be created - character(*), intent(in) :: fh_str ! parallel or serial HDF5 file - integer, optional, intent(in) :: proc_id ! processor rank to write from + character(*), intent(in) :: filename ! name of file to be created + integer, intent(in) :: unit ! optional unit number + logical, optional, intent(in) :: serial ! processor rank to write from + class(BinaryOutput) :: self - integer :: proc_create = 0 ! processor writing in serial (default master) + ! Check for serial option + if (present(serial)) then + self % serial = serial + else + self % serial = .false. + end if #ifdef HDF5 # ifdef MPI - ! Check for proc id - if (present(proc_id)) proc_create = proc_id - - ! Determine whether the file should be created by 1 or all procs - if (trim(fh_str) == 'serial') then - if(rank == proc_create) call hdf5_file_create(filename, hdf5_fh) + if (self % serial) then + call hdf5_file_create(filename, self % hdf5_fh) else - call hdf5_parallel_file_create(filename, hdf5_fh) + call hdf5_parallel_file_create(filename, self % hdf5_fh) endif # else - call hdf5_file_create(filename, hdf5_fh) + call hdf5_file_create(filename, self % hdf5_fh) # endif #elif MPI - call mpi_create_file(filename, mpi_fh) + if (self % serial) then + ! Check for specified unit + if (present(unit)) then + self % unit_fh = unit + else + self % unit_fh = 100 + end if + open(UNIT=self % unit_fh, FILE=filename, ACTION="write", & + STATUS='replace', ACCESS='stream') + else + call mpi_create_file(filename, self % unit_fh) + end if #else - open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION="write", & + ! Check for specified unit + if (present(unit)) then + self % unit_fh = unit + else + self % unit_fh = 100 + end if + + open(UNIT=self % unit_fh, FILE=filename, ACTION="write", & STATUS='replace', ACCESS='stream') #endif @@ -80,38 +133,65 @@ contains ! FILE_OPEN opens an existing file for reading or read/writing !=============================================================================== - subroutine file_open(filename, fh_str, mode, proc_id) + subroutine file_open(self, filename, mode, serial, unit) character(*), intent(in) :: filename ! name of file to be opened - character(*), intent(in) :: fh_str ! parallel or serial HDF5 file character(*), intent(in) :: mode ! file access mode - integer, optional, intent(in) :: proc_id ! processor rank to open file + integer, intent(in) :: unit ! optional unit number + logical, optional, intent(in) :: serial ! processor rank to write from + class(BinaryOutput) :: self - integer :: proc_open = 0 ! processor to open file (default is master) + ! Check for serial option + if (present(serial)) then + self % serial = serial + else + self % serial = .false. + end if #ifdef HDF5 # ifdef MPI - ! Check for proc_id - if (present(proc_id)) proc_open = proc_id - - ! Determine if the file should be opened by 1 or all procs - if (trim(fh_str) == 'serial') then - if (rank == proc_open) call hdf5_file_open(filename, hdf5_fh, mode) + if (self % serial) then + call hdf5_file_open(filename, self % hdf5_fh, mode) else - call hdf5_parallel_file_open(filename, hdf5_fh, mode) + call hdf5_parallel_file_open(filename, self % hdf5_fh, mode) endif # else - call hdf5_file_open(filename, hdf5_fh, mode) + call hdf5_file_open(filename, self % hdf5_fh, mode) # endif #elif MPI - call mpi_open_file(filename, mpi_fh, mode) + if (self % serial) then + ! Check for specified unit + if (present(unit)) then + self % unit_fh = unit + else + self % unit_fh = 100 + end if + + ! Check for read/write mode to open, default is read only + if (mode == 'w') then + open(UNIT=self % unit_fh, FILE=filename, ACTION='write', & + STATUS='old', ACCESS='stream') + else + open(UNIT=self % unit_fh, FILE=filename, ACTION='read', & + STATUS='old', ACCESS='stream') + end if + else + call mpi_open_file(filename, self % unit_fh, mode) + end if #else + ! Check for specified unit + if (present(unit)) then + self % unit_fh = unit + else + self % unit_fh = 100 + end if + ! Check for read/write mode to open, default is read only if (mode == 'w') then - open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION='write', & + open(UNIT=self % unit_fh, FILE=filename, ACTION='write', & STATUS='old', ACCESS='stream') else - open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION='read', & + open(UNIT=self % unit_fh, FILE=filename, ACTION='read', & STATUS='old', ACCESS='stream') end if #endif @@ -122,31 +202,24 @@ contains ! FILE_CLOSE closes a file !=============================================================================== - subroutine file_close(fh_str, proc_id) + subroutine file_close(self) - character(*), intent(in) :: fh_str ! serial or parallel hdf5 file - integer, optional, intent(in) :: proc_id ! processor rank to close file - - integer :: proc_close = 0 ! processor to close file + class(BinaryOutput) :: self #ifdef HDF5 # ifdef MPI - ! Check for proc_id - if (present(proc_id)) proc_close = proc_id - - ! Determine whether a file should be closed by 1 or all procs - if (trim(fh_str) == 'serial') then - if(rank == proc_close) call hdf5_file_close(hdf5_fh) - else - call hdf5_file_close(hdf5_fh) - endif + call hdf5_file_close(self % hdf5_fh) # else - call hdf5_file_close(hdf5_fh) + call hdf5_file_close(self % hdf5_fh) # endif #elif MPI - call mpi_close_file(mpi_fh) + if (self % serial) then + close(UNIT=self % unit_fh) + else + call mpi_close_file(self % unit_fh) + end if #else - close(UNIT=UNIT_OUTPUT) + close(UNIT=self % unit_fh) #endif end subroutine file_close @@ -155,12 +228,13 @@ contains ! WRITE_DOUBLE writes double precision scalar data !=============================================================================== - subroutine write_double(buffer, name, group, collect) + subroutine write_double(self, buffer, name, group, collect) real(8), intent(in) :: buffer ! data to write character(*), intent(in) :: name ! name for data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -174,23 +248,29 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Write the data using parallel routine - call hdf5_write_double_parallel(temp_group, name, buffer, collect_) + if (self % serial) then + call hdf5_write_double(self % hdf5_grp, name, buffer) + else + call hdf5_write_double_parallel(self % hdf5_grp, name, buffer, collect_) + end if # else - ! Write the data - call hdf5_write_double(temp_group, name, buffer) + call hdf5_write_double(self % hdf5_grp, name, buffer) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_write_double(mpi_fh, buffer, collect_) + if (self % serial) then + write(self % unit_fh) buffer + else + call mpi_write_double(self % unit_fh, buffer, collect_) + end if #else - write(UNIT_OUTPUT) buffer + write(self % unit_fh) buffer #endif end subroutine write_double @@ -199,12 +279,13 @@ contains ! READ_DOUBLE reads double precision scalar data !=============================================================================== - subroutine read_double(buffer, name, group, collect) + subroutine read_double(self, buffer, name, group, collect) real(8), intent(inout) :: buffer ! read data to here character(*), intent(in) :: name ! name for data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -218,23 +299,29 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Read the data using parallel routines - call hdf5_read_double_parallel(temp_group, name, buffer, collect_) + if (self % serial) then + call hdf5_read_double(self % hdf5_grp, name, buffer) + else + call hdf5_read_double_parallel(self % hdf5_grp, name, buffer, collect_) + end if # else - ! Read the data in serial - call hdf5_read_double(temp_group, name, buffer) + call hdf5_read_double(self % hdf5_grp, name, buffer) # endif ! Check if HDf5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_read_double(mpi_fh, buffer, collect_) + if (self % serial) then + read(self % unit_fh) buffer + else + call mpi_read_double(self % unit_fh, buffer, collect_) + end if #else - read(UNIT_OUTPUT) buffer + read(self % unit_fh) buffer #endif end subroutine read_double @@ -243,13 +330,14 @@ contains ! WRITE_DOUBLE_1DARRAY writes double presicions 1-D array data !=============================================================================== - subroutine write_double_1Darray(buffer, name, group, length, collect) + subroutine write_double_1Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length ! length of array to write real(8), intent(in) :: buffer(:) ! data to write character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -263,23 +351,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Write the data using parallel routine - call hdf5_write_double_1Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_write_double_1Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_write_double_1Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else - call hdf5_write_double_1Darray(temp_group, name, buffer, length) + call hdf5_write_double_1Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_write_double_1Darray(mpi_fh, buffer, length) + if (self % serial) then + write(self % unit_fh) buffer(1:length) + else + call mpi_write_double_1Darray(self % unit_fh, buffer, length) + end if #else - write(UNIT_OUTPUT) buffer(1:length) + write(self % unit_fh) buffer(1:length) #endif end subroutine write_double_1Darray @@ -288,13 +383,14 @@ contains ! READ_DOUBLE_1DARRAY reads double precision 1-D array data !=============================================================================== - subroutine read_double_1Darray(buffer, name, group, length, collect) + subroutine read_double_1Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length ! length of array to read real(8), intent(inout) :: buffer(:) ! read data to here character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name - character(*), intent(in), optional :: collect ! collective I/O + logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -308,24 +404,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Read the data using parallel routines - call hdf5_read_double_1Darray_parallel(temp_group, name, buffer, & + if (self % serial) then + call hdf5_read_double_1Darray(self % hdf5_fh, name, buffer, length) + else + call hdf5_read_double_1Darray_parallel(self % hdf5_fh, name, buffer, & length, collect_) + end if # else - ! Read the data in serial - call hdf5_read_double_1Darray(temp_group, name, buffer, length) + call hdf5_read_double_1Darray(self % hdf5_fh, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_fh) #elif MPI - call mpi_read_double_1Darray(mpi_fh, buffer, length) + if (self % serial) then + read(self % unit_fh) buffer(1:length) + else + call mpi_read_double_1Darray(self % unit_fh, buffer, length) + end if #else - read(UNIT_OUTPUT) buffer(1:length) + read(self % unit_fh) buffer(1:length) #endif end subroutine read_double_1Darray @@ -334,13 +436,14 @@ contains ! WRITE_DOUBLE_2DARRAY writes double precision 2-D array data !=============================================================================== - subroutine write_double_2Darray(buffer, name, group, length, collect) + subroutine write_double_2Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length(2) ! dimension of array real(8), intent(in) :: buffer(length(1),length(2)) ! the data character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -354,24 +457,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Write the data using parallel routines - call hdf5_write_double_2Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_write_double_2Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_write_double_2Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else - ! Write the data in serial - call hdf5_write_double_2Darray(temp_group, name, buffer, length) + call hdf5_write_double_2Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_write_double_2Darray(mpi_fh, buffer, length, collect_) + if (self % serial) then + write(self % unit_fh) buffer(1:length(1),1:length(2)) + else + call mpi_write_double_2Darray(self % unit_fh, buffer, length, collect_) + end if #else - write(UNIT_OUTPUT) buffer(1:length(1),1:length(2)) + write(self % unit_fh) buffer(1:length(1),1:length(2)) #endif end subroutine write_double_2Darray @@ -380,13 +489,14 @@ contains ! READ_DOUBLE_2DARRAY reads double precision 2-D array data !=============================================================================== - subroutine reads_double_2Darray(buffer, name, group, length, collect) + subroutine read_double_2Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length(2) ! dimension of array real(8), intent(inout) :: buffer(length(1),length(2)) ! the data character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -400,24 +510,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Read the data using parallel routines - call hdf5_read_double_2Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_read_double_2Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_read_double_2Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else - ! Read the data in serial - call hdf5_read_double_2Darray(temp_group, name, buffer, length) + call hdf5_read_double_2Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_read_double_2Darray(mpi_fh, buffer, length, collect_) + if (self % serial) then + read(self % unit_fh) buffer(1:length(1),1:length(2)) + then + call mpi_read_double_2Darray(self % unit_fh, buffer, length, collect_) + end if #else - read(UNIT_OUTPUT) buffer(1:length(1),1:length(2)) + read(self % unit_fh) buffer(1:length(1),1:length(2)) #endif end subroutine read_double_2Darray @@ -426,13 +542,16 @@ contains ! WRITE_DOUBLE_3DARRAY writes double precision 3-D array data !=============================================================================== - subroutine write_double_3Darray(buffer, name, group, length, collect) + subroutine write_double_3Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length(3) ! length of each dimension real(8), intent(in) :: buffer(length(1),length(2),length(3)) character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self + + logical :: collect_ ! Set up collective vs. independent I/O if (present(collect)) then @@ -444,24 +563,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Write the data using parallel routines - call hdf5_write_double_3Darray_parallel(temp_group, name, buffer, length, & + if (self % serial) then + call hdf5_write_double_3Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_write_double_3Darray_parallel(self % hdf5_grp, name, buffer, length, & collect_) + end if # else - ! Write the data in serial - call hdf5_write_double_3Darray(temp_group, name, buffer, length) + call hdf5_write_double_3Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_write_double_3Darray(mpi_fh, buffer, length, collect_) + if (self % serial) then + write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) + else + call mpi_write_double_3Darray(self % unit_fh, buffer, length, collect_) + end if #else - write(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3)) + write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) #endif end subroutine write_double_3Darray @@ -470,13 +595,16 @@ contains ! READ_DOUBLE_3DARRAY reads double precision 3-D array data !=============================================================================== - subroutine read_double_3Darray(buffer, name, group, length, collect) + subroutine read_double_3Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length(3) ! length of each dimension real(8), intent(inout) :: buffer(length(1),length(2),length(3)) character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self + + logical :: collect_ ! Set up collective vs. independent I/O if (present(collect)) then @@ -488,24 +616,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Read the data using parallel routines - call hdf5_read_double_3Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_read_double_3Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_read_double_3Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else - ! Read the data in serial - call hdf5_read_double_3Darray(temp_group, name, buffer, length) + call hdf5_read_double_3Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_read_double_3Darray(mpi_fh, buffer, length, collect_) + if (self % serial) then + read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) + else + call mpi_read_double_3Darray(self % unit_fh, buffer, length, collect_) + end if #else - read(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3)) + read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) #endif end subroutine read_double_3Darray @@ -514,7 +648,7 @@ contains ! WRITE_DOUBLE_4DARRAY writes double precision 4-D array data !=============================================================================== - subroutine write_double_4Darray(buffer, name, group, length, collect) + subroutine write_double_4Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length(4) ! length of each dimension real(8), intent(in) :: buffer(length(1),length(2),& @@ -522,6 +656,7 @@ contains character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -535,24 +670,32 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Write the data using parallel routines - call hdf5_write_double_4Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_write_double_4Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_write_double_4Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else ! Write the data in serial - call hdf5_write_double_4Darray(temp_group, name, buffer, length) + call hdf5_write_double_4Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_write_double_4Darray(mpi_fh, buffer, length, collect_) + if (self % serial) then + write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & + 1:length(4)) + else + call mpi_write_double_4Darray(self % unit_fh, buffer, length, collect_) + end if #else - write(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3), & + write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & 1:length(4)) #endif @@ -562,7 +705,7 @@ contains ! READ_DOUBLE_4DARRAY reads double precision 4-D array data !=============================================================================== - subroutine read_double_4Darray(buffer, name, group, length, collect) + subroutine read_double_4Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length(4) ! length of each dimension real(8), intent(inout) :: buffer(length(1),length(2),& @@ -570,6 +713,7 @@ contains character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -583,24 +727,31 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Read the data using parallel routines - call hdf5_read_double_4Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_read_double_4Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_read_double_4Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else - ! Read the data in serial - call hdf5_read_double_4Darray(temp_group, name, buffer, length) + call hdf5_read_double_4Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_read_double_4Darray(mpi_fh, buffer, length, collect_) + if (self % serial) then + read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & + 1:length(4)) + else + call mpi_read_double_4Darray(self % unit_fh, buffer, length, collect_) + end if #else - read(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3), & + read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & 1:length(4)) #endif @@ -610,12 +761,13 @@ contains ! WRITE_INTEGER writes integer precision scalar data !=============================================================================== - subroutine write_integer(buffer, name, group, collect) + subroutine write_integer(self, buffer, name, group, collect) integer, intent(in) :: buffer ! data to write character(*), intent(in) :: name ! name for data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -629,23 +781,29 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Write the data using parallel routine - call hdf5_write_integer_parallel(temp_group, name, buffer, collect_) + if (self % serial) then + call hdf5_write_integer(self % hdf5_grp, name, buffer) + else + call hdf5_write_integer_parallel(self % hdf5_grp, name, buffer, collect_) + end if # else - ! Write the data - call hdf5_write_integer(temp_group, name, buffer) + call hdf5_write_integer(self % hdf5_grp, name, buffer) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_write_integer(mpi_fh, buffer, collect_) + if (self % serial) then + write(self % unit_fh) buffer + else + call mpi_write_integer(self % unit_fh, buffer, collect_) + end if #else - write(UNIT_OUTPUT) buffer + write(self % unit_fh) buffer #endif end subroutine write_integer @@ -654,12 +812,13 @@ contains ! READ_INTEGER reads integer precision scalar data !=============================================================================== - subroutine read_integer(buffer, name, group, collect) + subroutine read_integer(self, buffer, name, group, collect) integer, intent(inout) :: buffer ! read data to here character(*), intent(in) :: name ! name for data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -673,23 +832,29 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Read the data using parallel routines - call hdf5_read_integer_parallel(temp_group, name, buffer, collect_) + if (self % serial) then + call hdf5_read_integer(self % hdf5_grp, name, buffer) + else + call hdf5_read_integer_parallel(self % hdf5_grp, name, buffer, collect_) + end if # else - ! Read the data in serial - call hdf5_read_integer(temp_group, name, buffer) + call hdf5_read_integer(self % hdf5_grp, name, buffer) # endif ! Check if HDf5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_read_integer(mpi_fh, buffer, collect_) + if (self % serial) then + read(self % unit_fh) buffer + else + call mpi_read_integer(self % unit_fh, buffer, collect_) + end if #else - read(UNIT_OUTPUT) buffer + read(self % unit_fh) buffer #endif end subroutine read_integer @@ -698,13 +863,14 @@ contains ! WRITE_INTEGER_1DARRAY writes integer presicions 1-D array data !=============================================================================== - subroutine write_integer_1Darray(buffer, name, group, length, collect) + subroutine write_integer_1Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length ! length of array to write integer, intent(in) :: buffer(:) ! data to write character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -718,23 +884,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Write the data using parallel routine - call hdf5_write_integer_1Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_write_integer_1Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_write_integer_1Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else - call hdf5_write_integer_1Darray(temp_group, name, buffer, length) + call hdf5_write_integer_1Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_write_integer_1Darray(mpi_fh, buffer, length) + if (self % serial) then + write(self % unit_fh) buffer(1:length) + else + call mpi_write_integer_1Darray(self % unit_fh, buffer, length) + end if #else - write(UNIT_OUTPUT) buffer(1:length) + write(self % unit_fh) buffer(1:length) #endif end subroutine write_integer_1Darray @@ -743,13 +916,14 @@ contains ! READ_INTEGER_1DARRAY reads integer precision 1-D array data !=============================================================================== - subroutine read_integer_1Darray(buffer, name, group, length, collect) + subroutine read_integer_1Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length ! length of array to read integer, intent(inout) :: buffer(:) ! read data to here character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name - character(*), intent(in), optional :: collect ! collective I/O + logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -763,24 +937,31 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Read the data using parallel routines - call hdf5_read_integer_1Darray_parallel(temp_group, name, buffer, & - length, collect_) + if (self % serial) then + call hdf5_read_integer_1Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_read_integer_1Darray_parallel(self % hdf5_grp, name, buffer, & + length, collect_) + end if # else ! Read the data in serial - call hdf5_read_integer_1Darray(temp_group, name, buffer, length) + call hdf5_read_integer_1Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_read_integer_1Darray(mpi_fh, buffer, length) + if (self % serial) then + read(self % unit_fh) buffer(1:length) + else + call mpi_read_integer_1Darray(self % unit_fh, buffer, length) + end if #else - read(UNIT_OUTPUT) buffer(1:length) + read(self % unit_fh) buffer(1:length) #endif end subroutine read_integer_1Darray @@ -789,13 +970,14 @@ contains ! WRITE_INTEGER_2DARRAY writes integer precision 2-D array data !=============================================================================== - subroutine write_integer_2Darray(buffer, name, group, length, collect) + subroutine write_integer_2Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length(2) ! dimension of array integer, intent(in) :: buffer(length(1),length(2)) ! the data character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -809,24 +991,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Write the data using parallel routines - call hdf5_write_integer_2Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_write_integer_2Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_write_integer_2Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else - ! Write the data in serial - call hdf5_write_integer_2Darray(temp_group, name, buffer, length) + call hdf5_write_integer_2Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_write_integer_2Darray(mpi_fh, buffer, length, collect_) + if (self % serial) then + write(self % unit_fh) buffer(1:length(1),1:length(2)) + else + call mpi_write_integer_2Darray(self % unit_fh, buffer, length, collect_) + end if #else - write(UNIT_OUTPUT) buffer(1:length(1),1:length(2)) + write(self % unit_fh) buffer(1:length(1),1:length(2)) #endif end subroutine write_integer_2Darray @@ -835,13 +1023,14 @@ contains ! READ_INTEGER_2DARRAY reads integer precision 2-D array data !=============================================================================== - subroutine reads_integer_2Darray(buffer, name, group, length, collect) + subroutine read_integer_2Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length(2) ! dimension of array integer, intent(inout) :: buffer(length(1),length(2)) ! the data character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -855,24 +1044,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Read the data using parallel routines - call hdf5_read_integer_2Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_read_integer_2Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_read_integer_2Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else - ! Read the data in serial - call hdf5_read_integer_2Darray(temp_group, name, buffer, length) + call hdf5_read_integer_2Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_read_integer_2Darray(mpi_fh, buffer, length, collect_) + if (self % serial) then + read(self % unit_fh) buffer(1:length(1),1:length(2)) + else + call mpi_read_integer_2Darray(self % unit_fh, buffer, length, collect_) + end if #else - read(UNIT_OUTPUT) buffer(1:length(1),1:length(2)) + read(self % unit_fh) buffer(1:length(1),1:length(2)) #endif end subroutine read_integer_2Darray @@ -881,13 +1076,16 @@ contains ! WRITE_INTEGER_3DARRAY writes integer precision 3-D array data !=============================================================================== - subroutine write_integer_3Darray(buffer, name, group, length, collect) + subroutine write_integer_3Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length(3) ! length of each dimension integer, intent(in) :: buffer(length(1),length(2),length(3)) character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self + + logical :: collect_ ! Set up collective vs. independent I/O if (present(collect)) then @@ -899,24 +1097,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Write the data using parallel routines - call hdf5_write_integer_3Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_write_integer_3Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_write_integer_3Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else - ! Write the data in serial - call hdf5_write_integer_3Darray(temp_group, name, buffer, length) + call hdf5_write_integer_3Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_write_integer_3Darray(mpi_fh, buffer, length, collect_) + if (self % serial) then + write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) + else + call mpi_write_integer_3Darray(self % unit_fh, buffer, length, collect_) + end if #else - write(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3)) + write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) #endif end subroutine write_integer_3Darray @@ -925,13 +1129,16 @@ contains ! READ_INTEGER_3DARRAY reads integer precision 3-D array data !=============================================================================== - subroutine read_integer_3Darray(buffer, name, group, length, collect) + subroutine read_integer_3Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length(3) ! length of each dimension integer, intent(inout) :: buffer(length(1),length(2),length(3)) character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self + + logical :: collect_ ! Set up collective vs. independent I/O if (present(collect)) then @@ -943,24 +1150,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Read the data using parallel routines - call hdf5_read_integer_3Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_read_integer_3Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_read_integer_3Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else - ! Read the data in serial - call hdf5_read_integer_3Darray(temp_group, name, buffer, length) + call hdf5_read_integer_3Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_read_integer_3Darray(mpi_fh, buffer, length, collect_) + if (self % serial) then + read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) + else + call mpi_read_integer_3Darray(self % unit_fh, buffer, length, collect_) + end if #else - read(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3)) + read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) #endif end subroutine read_integer_3Darray @@ -969,7 +1182,7 @@ contains ! WRITE_INTEGER_4DARRAY writes integer precision 4-D array data !=============================================================================== - subroutine write_integer_4Darray(buffer, name, group, length, collect) + subroutine write_integer_4Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length(4) ! length of each dimension integer, intent(in) :: buffer(length(1),length(2),& @@ -977,6 +1190,7 @@ contains character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -990,24 +1204,31 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Write the data using parallel routines - call hdf5_write_integer_4Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_write_integer_4Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_write_integer_4Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else - ! Write the data in serial - call hdf5_write_integer_4Darray(temp_group, name, buffer, length) + call hdf5_write_integer_4Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_write_integer_4Darray(mpi_fh, buffer, length, collect_) + if (self % serial) then + write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & + 1:length(4)) + else + call mpi_write_integer_4Darray(self % unit_fh, buffer, length, collect_) + end if #else - write(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3), & + write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & 1:length(4)) #endif @@ -1017,7 +1238,7 @@ contains ! READ_INTEGER_4DARRAY reads integer precision 4-D array data !=============================================================================== - subroutine read_integer_4Darray(buffer, name, group, length, collect) + subroutine read_integer_4Darray(self, buffer, name, group, length, collect) integer, intent(in) :: length(4) ! length of each dimension integer, intent(inout) :: buffer(length(1),length(2),& @@ -1025,6 +1246,7 @@ contains character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self logical :: collect_ @@ -1038,24 +1260,31 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Read the data using parallel routines - call hdf5_read_integer_4Darray_parallel(temp_group, name, buffer, length, & - collect_) + if (self % serial) then + call hdf5_read_integer_4Darray(self % hdf5_grp, name, buffer, length) + else + call hdf5_read_integer_4Darray_parallel(self % hdf5_grp, name, buffer, length, & + collect_) + end if # else - ! Read the data in serial - call hdf5_read_integer_4Darray(temp_group, name, buffer, length) + call hdf5_read_integer_4Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_read_integer_4Darray(mpi_fh, buffer, length, collect_) + if (self % serial) then + read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & + 1:length(4)) + else + call mpi_read_integer_4Darray(self % unit_fh, buffer, length, collect_) + end if #else - read(UNIT_OUTPUT) buffer(1:length(1),1:length(2),1:length(3), & + read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & 1:length(4)) #endif @@ -1065,12 +1294,15 @@ contains ! WRITE_LONG writes long integer scalar data !=============================================================================== - subroutine write_long(buffer, name, group, collect) + subroutine write_long(self, buffer, name, group, collect) integer(8), intent(in) :: buffer ! data to write character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self + + logical :: collect_ ! Set up collective vs. independent I/O if (present(collect)) then @@ -1082,23 +1314,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Write the data using parallel routine - call hdf5_write_long_parallel(temp_group, name, buffer, collect_) + if (self % serial) then + call hdf5_write_long(self % hdf5_grp, name, buffer, hdf5_integer8_t) + else + call hdf5_write_long_parallel(self % hdf5_grp, name, buffer, & + hdf5_integer8_t, collect_) + end if # else - ! Write the data - call hdf5_write_long(temp_group, name, buffer) + call hdf5_write_long(self % hdf5_grp, name, buffer, hdf5_integer8_t) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_write_long(mpi_fh, buffer, collect_) + if (self % serial) then + write(self % unit_fh) buffer + else + call mpi_write_long(self % unit_fh, buffer, collect_) + end if #else - write(UNIT_OUTPUT) buffer + write(self % unit_fh) buffer #endif end subroutine write_long @@ -1107,12 +1346,15 @@ contains ! READ_LONG reads long integer scalar data !=============================================================================== - subroutine read_long(buffer, name, group, collect) + subroutine read_long(self, buffer, name, group, collect) integer(8), intent(inout) :: buffer ! data to write character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self + + logical :: collect_ ! Set up collective vs. independent I/O if (present(collect)) then @@ -1124,23 +1366,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Read the data using parallel routine - call hdf5_read_long_parallel(temp_group, name, buffer, collect_) + if (self % serial) then + call hdf5_read_long(self % hdf5_grp, name, buffer, hdf5_integer8_t) + else + call hdf5_read_long_parallel(self % hdf5_grp, name, buffer, & + hdf5_integer8_t, collect_) + end if # else - ! Read the data - call hdf5_read_long(temp_group, name, buffer) + call hdf5_read_long(self % hdf5_grp, name, buffer, hdf5_integer8_t) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_read_long(mpi_fh, buffer, collect_) + if (self % serial) then + write(self % unit_fh) buffer + else + call mpi_read_long(self % unit_fh, buffer, collect_) + end if #else - write(UNIT_OUTPUT) buffer + write(self % unit_fh) buffer #endif end subroutine read_long @@ -1149,12 +1398,13 @@ contains ! WRITE_STRING writes string data !=============================================================================== - subroutine write_string(buffer, name, group, collect) + subroutine write_string(self, buffer, name, group, collect) character(*), intent(in) :: buffer ! data to write character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self integer :: n logical :: collect_ @@ -1172,23 +1422,30 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Write the data using parallel routine - call hdf5_write_string_parallel(temp_group, name, buffer, n, collect_) + if (self % serial) then + call hdf5_write_string(self % hdf5_grp, name, buffer, n) + else + call hdf5_write_string_parallel(self % hdf5_grp, name, buffer, n, collect_) + end if # else ! Write the data - call hdf5_write_string(temp_group, name, n, buffer) + call hdf5_write_string(self % hdf5_grp, name, n, buffer) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_write_string(mpi_fh, buffer, n, collect_) + if (self % serial) then + write(self % unit_fh) buffer + else + call mpi_write_string(self % unit_fh, buffer, n, collect_) + end if #else - write(UNIT_OUTPUT) buffer + write(self % unit_fh) buffer #endif end subroutine write_string @@ -1197,12 +1454,13 @@ contains ! READ_STRING reads string data !=============================================================================== - subroutine read_string(buffer, name, group, collect) + subroutine read_string(self, buffer, name, group, collect) - character(*), intent(in) :: buffer ! data to write - character(*), intent(inout) :: name ! name of data + character(*), intent(inout) :: buffer ! data to write + character(*), intent(in) :: name ! name of data character(*), intent(in), optional :: group ! HDF5 group name logical, intent(in), optional :: collect ! collective I/O + class(BinaryOutput) :: self integer :: n logical :: collect_ @@ -1220,23 +1478,29 @@ contains #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif # ifdef MPI - ! Read the data using parallel routine - call hdf5_read_string_parallel(temp_group, name, buffer, n, collect_) + if (self % serial) then + call hdf5_read_string(self % hdf5_grp, name, buffer, n) + else + call hdf5_read_string_parallel(self % hdf5_grp, name, buffer, n, collect_) + end if # else - ! Read the data - call hdf5_read_string(temp_group, name, n, buffer) + call hdf5_read_string(self % hdf5_grp, name, n, buffer) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI - call mpi_read_string(mpi_fh, buffer, n, collect_) + if (self % serial) then + write(self % unit_fh) buffer + else + call mpi_read_string(self % unit_fh, buffer, n, collect_) + end if #else - write(UNIT_OUTPUT) buffer + write(self % unit_fh) buffer #endif end subroutine read_string @@ -1245,26 +1509,27 @@ contains ! WRITE_ATTRIBUTE_STRING !=============================================================================== - subroutine write_attribute_string(var, attr_type, attr_str, group) + subroutine write_attribute_string(self, var, attr_type, attr_str, group) character(*), intent(in) :: var ! variable name for attr character(*), intent(in) :: attr_type ! attr identifier type character(*), intent(in) :: attr_str ! string for attr id type character(*), intent(in), optional :: group ! HDF5 group name + class(BinaryOutput) :: self #ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh endif ! Write the attribute string - call hdf5_write_attribute_string(temp_group, var, attr_type, attr_str) + call hdf5_write_attribute_string(self % hdf5_grp, var, attr_type, attr_str) ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group() + if (present(group)) call hdf5_close_group(self % hdf5_grp) #endif end subroutine write_attribute_string @@ -1273,12 +1538,13 @@ contains ! WRITE_TALLY_RESULT writes an OpenMC TallyResult type !=============================================================================== - subroutine write_tally_result(buffer, name, group, n1, n2) + subroutine write_tally_result(self, buffer, name, group, n1, n2) character(*), intent(in), optional :: group ! HDF5 group name character(*), intent(in) :: name ! name of data integer, intent(in) :: n1, n2 ! TallyResult dims type(TallyResult), intent(in), target :: buffer(n1, n2) ! data to write + class(BinaryOutput) :: self #ifndef HDF5 # ifndef MPI @@ -1290,9 +1556,9 @@ contains ! Open up sub-group if present if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh end if ! Set overall size of vector to write @@ -1302,7 +1568,7 @@ contains call h5screate_simple_f(1, dims1, dspace, hdf5_err) ! Create the dataset - call h5dcreate_f(temp_group, name, hdf5_tallyresult_t, dspace, dset, & + call h5dcreate_f(self % hdf5_grp, name, hdf5_tallyresult_t, dspace, dset, & hdf5_err) ! Set pointer to first value and write @@ -1313,22 +1579,16 @@ contains call h5dclose_f(dset, hdf5_err) call h5sclose_f(dspace, hdf5_err) if (present(group)) then - call hdf5_close_group() + call hdf5_close_group(self % hdf5_grp) end if -#elif MPI - - ! Write out tally buffer - call MPI_FILE_WRITE(mpi_fh, buffer, n1*n2, MPI_TALLYRESULT, & - MPI_STATUS_IGNORE, mpiio_err) - #else ! Write out tally buffer do k = 1, n2 do j = 1, n1 - write(UNIT_OUTPUT) buffer(j,k) % sum - write(UNIT_OUTPUT) buffer(j,k) % sum_sq + write(self % unit_fh) buffer(j,k) % sum + write(self % unit_fh) buffer(j,k) % sum_sq end do end do @@ -1340,12 +1600,13 @@ contains ! READ_TALLY_RESULT reads OpenMC TallyResult data !=============================================================================== - subroutine read_tally_result(buffer, name, group, n1, n2) + subroutine read_tally_result(self, buffer, name, group, n1, n2) character(*), intent(in), optional :: group ! HDF5 group name character(*), intent(in) :: name ! name of data integer, intent(in) :: n1, n2 ! TallyResult dims type(TallyResult), intent(inout), target :: buffer(n1, n2) ! read data here + class(BinaryOutput) :: self #ifndef HDF5 # ifndef MPI @@ -1357,13 +1618,13 @@ contains ! Open up sub-group if present if (present(group)) then - call hdf5_open_group(group) + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) else - temp_group = hdf5_fh + self % hdf5_grp = self % hdf5_fh end if ! Open the dataset - call h5dopen_f(temp_group, name, dset, hdf5_err) + call h5dopen_f(self % hdf5_grp, name, dset, hdf5_err) ! Set pointer to first value and write f_ptr = c_loc(buffer(1,1)) @@ -1371,21 +1632,15 @@ contains ! Close ids call h5dclose_f(dset, hdf5_err) - if (present(group)) call hdf5_close_group() - -#elif MPI - - ! Write out tally buffer - call MPI_FILE_READ(mpi_fh, buffer, n1*n2, MPI_TALLYRESULT, & - MPI_STATUS_IGNORE, mpiio_err) + if (present(group)) call hdf5_close_group(self % hdf5_grp) #else ! Write out tally buffer do k = 1, n2 do j = 1, n1 - read(UNIT_OUTPUT) buffer(j,k) % sum - read(UNIT_OUTPUT) buffer(j,k) % sum_sq + read(self % unit_fh) buffer(j,k) % sum + read(self % unit_fh) buffer(j,k) % sum_sq end do end do @@ -1398,7 +1653,9 @@ contains ! WRITE_SOURCE_BANK writes OpenMC source_bank data !=============================================================================== - subroutine write_source_bank() + subroutine write_source_bank(self) + + class(BinaryOutput) :: self #ifdef HDF5 integer(8) :: offset(1) ! source data offset @@ -1419,7 +1676,7 @@ contains call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) ! Create the dataset for that dataspace - call h5dcreate_f(hdf5_fh, "source_bank", hdf5_bank_t, dspace, dset, hdf5_err) + call h5dcreate_f(self % hdf5_fh, "source_bank", hdf5_bank_t, dspace, dset, hdf5_err) ! Close the dataspace call h5sclose_f(dspace, hdf5_err) @@ -1463,7 +1720,7 @@ contains call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) ! Create dataset - call h5dcreate_f(hdf5_fh, "source_bank", hdf5_bank_t, & + call h5dcreate_f(self % hdf5_fh, "source_bank", hdf5_bank_t, & dspace, dset, hdf5_err) ! Set up pointer to data @@ -1481,7 +1738,7 @@ contains #elif MPI ! Get current offset for master - if (master) call MPI_FILE_GET_POSITION(mpi_fh, offset, mpiio_err) + if (master) call MPI_FILE_GET_POSITION(self % unit_fh, offset, mpiio_err) ! Determine offset on master process and broadcast to all processors call MPI_SIZEOF(offset, size_offset_kind, mpi_err) @@ -1497,13 +1754,13 @@ contains offset = offset + size_bank*maxwork*rank ! Write all source sites - call MPI_FILE_WRITE_AT(mpi_fh, offset, source_bank(1), work, MPI_BANK, & + call MPI_FILE_WRITE_AT(self % unit_fh, offset, source_bank(1), work, MPI_BANK, & MPI_STATUS_IGNORE, mpiio_err) #else ! Write out source sites - write(UNIT_OUTPUT) source_bank + write(self % unit_fh) source_bank #endif @@ -1513,7 +1770,9 @@ contains ! READ_SOURCE_BANK reads OpenMC source_bank data !=============================================================================== - subroutine read_source_bank() + subroutine read_source_bank(self) + + class(BinaryOutput) :: self #ifdef HDF5 integer(8) :: offset(1) ! offset of data @@ -1531,7 +1790,7 @@ contains hdf5_rank = 1 ! Open the dataset - call h5dopen_f(hdf5_fh, "source_bank", dset, hdf5_err) + call h5dopen_f(self % hdf5_fh, "source_bank", dset, hdf5_err) ! Create another data space but for each proc individually dims1(1) = work @@ -1565,7 +1824,7 @@ contains # else ! Open dataset - call h5dopen_f(hdf5_fh, "source_bank", dset, hdf5_err) + call h5dopen_f(self % hdf5_fh, "source_bank", dset, hdf5_err) ! Set up pointer to data f_ptr = c_loc(source_bank(1)) @@ -1581,7 +1840,7 @@ contains #elif MPI ! Get current offset for master - if (master) call MPI_FILE_GET_POSITION(mpi_fh, offset, mpiio_err) + if (master) call MPI_FILE_GET_POSITION(self % unit_fh, offset, mpiio_err) ! Determine offset on master process and broadcast to all processors call MPI_SIZEOF(offset, size_offset_kind, mpi_err) @@ -1597,13 +1856,13 @@ contains offset = offset + size_bank*maxwork*rank ! Write all source sites - call MPI_FILE_READ_AT(mpi_fh, offset, source_bank(1), work, MPI_BANK, & + call MPI_FILE_READ_AT(self % unit_fh, offset, source_bank(1), work, MPI_BANK, & MPI_STATUS_IGNORE, mpiio_err) #else ! Write out source sites - read(UNIT_OUTPUT) source_bank + read(self % unit_fh) source_bank #endif From 122e2f5e614f7bf569ea1e759bc5f81ac7782b07 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 1 Aug 2013 04:56:29 -0400 Subject: [PATCH 06/21] re-did statepoint and summary to work with new output interfaces --- src/hdf5_summary.F90 | 298 +++++++++++++++++++------------------ src/initialize.F90 | 9 +- src/output_interface.F90 | 34 +++-- src/state_point.F90 | 312 +++++++++++++++++++-------------------- 4 files changed, 327 insertions(+), 326 deletions(-) diff --git a/src/hdf5_summary.F90 b/src/hdf5_summary.F90 index 3963b0035b..f6b3e2f6b8 100644 --- a/src/hdf5_summary.F90 +++ b/src/hdf5_summary.F90 @@ -7,6 +7,7 @@ module hdf5_summary use endf, only: reaction_name use geometry_header, only: Cell, Surface, Universe, Lattice use global + use hdf5_interface, only: hdf5_open_group, hdf5_close_group use material_header, only: Material use mesh_header, only: StructuredMesh use output_interface @@ -14,6 +15,10 @@ module hdf5_summary use string, only: to_str use tally_header, only: TallyObject + implicit none + + type(BinaryOutput) :: su + contains !=============================================================================== @@ -25,7 +30,7 @@ contains character(MAX_FILE_LEN) :: filename = "summary.h5" ! Create a new file using default properties. - call file_create(filename, "serial") + call su % file_create(filename, serial=.true.) ! Write header information call hdf5_write_header() @@ -34,24 +39,24 @@ contains if (run_mode == MODE_EIGENVALUE) then ! Write number of particles - call write_data(n_particles, "n_particles") + call su % write_data(n_particles, "n_particles") ! Use H5LT interface to write n_batches, n_inactive, and n_active - call write_data(n_batches, "n_batches") - call write_data(n_inactive, "n_inactive") - call write_data(n_active, "n_active") - call write_data(gen_per_batch, "gen_per_batch") + call su % write_data(n_batches, "n_batches") + call su % write_data(n_inactive, "n_inactive") + call su % write_data(n_active, "n_active") + call su % write_data(gen_per_batch, "gen_per_batch") ! Add description of each variable - call write_attribute_string("n_particles", & + call su % write_attribute_string("n_particles", & "description", "Number of particles per generation") - call write_attribute_string("n_batches", & + call su % write_attribute_string("n_batches", & "description", "Total number of batches") - call write_attribute_string("n_inactive", & + call su % write_attribute_string("n_inactive", & "description", "Number of inactive batches") - call write_attribute_string("n_active", & + call su % write_attribute_string("n_active", & "description", "Number of active batches") - call write_attribute_string("gen_per_batch", & + call su % write_attribute_string("gen_per_batch", & "description", "Number of generations per batch") end if @@ -63,7 +68,7 @@ contains end if ! Terminate access to the file. - call file_close("serial") + call su % file_close() end subroutine hdf5_write_summary @@ -74,16 +79,16 @@ contains subroutine hdf5_write_header() ! Write version information - call write_data(VERSION_MAJOR, "version_major") - call write_data(VERSION_MINOR, "version_minor") - call write_data(VERSION_RELEASE, "version_release") + call su % write_data(VERSION_MAJOR, "version_major") + call su % write_data(VERSION_MINOR, "version_minor") + call su % write_data(VERSION_RELEASE, "version_release") ! Write current date and time - call write_data(time_stamp(), "date_and_time") + call su % write_data(time_stamp(), "date_and_time") ! Write MPI information - call write_data(n_procs, "n_procs") - call write_attribute_string("n_procs", "description", & + call su % write_data(n_procs, "n_procs") + call su % write_attribute_string("n_procs", "description", & "Number of MPI processes") end subroutine hdf5_write_header @@ -103,53 +108,53 @@ contains type(Lattice), pointer :: lat => null() ! Use H5LT interface to write number of geometry objects - call write_data(n_cells, "n_cells", group="geometry") - call write_data(n_surfaces, "n_surfaces", group="geometry") - call write_data(n_universes, "n_universes", group="geometry") - call write_data(n_lattices, "n_lattices", group="geometry") + call su % write_data(n_cells, "n_cells", group="geometry") + call su % write_data(n_surfaces, "n_surfaces", group="geometry") + call su % write_data(n_universes, "n_universes", group="geometry") + call su % write_data(n_lattices, "n_lattices", group="geometry") ! ========================================================================== ! WRITE INFORMATION ON CELLS ! Create a cell group (nothing directly written in this group) then close - call hdf5_open_group("geometry/cells") - call hdf5_close_group() + call hdf5_open_group(su % hdf5_fh, "geometry/cells", su % hdf5_grp) + call hdf5_close_group(su % hdf5_grp) ! Write information on each cell CELL_LOOP: do i = 1, n_cells c => cells(i) ! Write universe for this cell - call write_data(universes(c % universe) % id, "universe", & + call su % write_data(universes(c % universe) % id, "universe", & group="geometry/cells/cell " // trim(to_str(c % id))) ! Write information on what fills this cell select case (c % type) case (CELL_NORMAL) - call write_data("normal", "fill_type", & + call su % write_data("normal", "fill_type", & group="geometry/cells/cell " // trim(to_str(c % id))) if (c % material == MATERIAL_VOID) then - call write_data(-1, "material", & + call su % write_data(-1, "material", & group="geometry/cells/cell " // trim(to_str(c % id))) else - call write_data(materials(c % material) % id, "material", & + call su % write_data(materials(c % material) % id, "material", & group="geometry/cells/cell " // trim(to_str(c % id))) end if case (CELL_FILL) - call write_data("universe", "fill_type", & + call su % write_data("universe", "fill_type", & group="geometry/cells/cell " // trim(to_str(c % id))) - call write_data(universes(c % fill) % id, "material", & + call su % write_data(universes(c % fill) % id, "material", & group="geometry/cells/cell " // trim(to_str(c % id))) case (CELL_LATTICE) - call write_data("lattice", "fill_type", & + call su % write_data("lattice", "fill_type", & group="geometry/cells/cell " // trim(to_str(c % id))) - call write_data(lattices(c % fill) % id, "lattice", & + call su % write_data(lattices(c % fill) % id, "lattice", & group="geometry/cells/cell " // trim(to_str(c % id))) end select ! Write list of bounding surfaces if (c % n_surfaces > 0) then - call write_data(c % surfaces, "surfaces", length= c % n_surfaces, & + call su % write_data(c % surfaces, "surfaces", length= c % n_surfaces, & group="geometry/cells/cell " // trim(to_str(c % id))) end if @@ -159,8 +164,8 @@ contains ! WRITE INFORMATION ON SURFACES ! Create surfaces group (nothing directly written here) then close - call hdf5_open_group("geometry/surfaces") - call hdf5_close_group() + call hdf5_open_group(su % hdf5_fh, "geometry/surfaces", su % hdf5_grp) + call hdf5_close_group(su % hdf5_grp) ! Write information on each surface SURFACE_LOOP: do i = 1, n_surfaces @@ -169,54 +174,54 @@ contains ! Write surface type select case (s % type) case (SURF_PX) - call write_data("X Plane", "type", & + call su % write_data("X Plane", "type", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_PY) - call write_data("Y Plane", "type", & + call su % write_data("Y Plane", "type", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_PZ) - call write_data("Z Plane", "type", & + call su % write_data("Z Plane", "type", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_PLANE) - call write_data("Plane", "type", & + call su % write_data("Plane", "type", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_CYL_X) - call write_data("X Cylinder", "type", & + call su % write_data("X Cylinder", "type", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_CYL_Y) - call write_data("Y Cylinder", "type", & + call su % write_data("Y Cylinder", "type", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_CYL_Z) - call write_data("Z Cylinder", "type", & + call su % write_data("Z Cylinder", "type", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_SPHERE) - call write_data("Sphere", "type", & + call su % write_data("Sphere", "type", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_CONE_X) - call write_data("X Cone", "type", & + call su % write_data("X Cone", "type", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_CONE_Y) - call write_data("Y Cone", "type", & + call su % write_data("Y Cone", "type", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_CONE_Z) - call write_data("Z Cone", "type", & + call su % write_data("Z Cone", "type", & group="geometry/surfaces/surface " // trim(to_str(s % id))) end select ! Write coefficients for surface - call write_data(s % coeffs, "coefficients", length=size(s % coeffs), & + call su % write_data(s % coeffs, "coefficients", length=size(s % coeffs), & group="geometry/surfaces/surface " // trim(to_str(s % id))) ! Write positive neighbors if (allocated(s % neighbor_pos)) then - call write_data(s % neighbor_pos, "neighbors_positive", & + call su % write_data(s % neighbor_pos, "neighbors_positive", & length=size(s % neighbor_pos), & group="geometry/surfaces/surface " // trim(to_str(s % id))) end if ! Write negative neighbors if (allocated(s % neighbor_neg)) then - call write_data(s % neighbor_neg, "neighbors_negative", & + call su % write_data(s % neighbor_neg, "neighbors_negative", & length=size(s % neighbor_neg), & group="geometry/surfaces/surface " // trim(to_str(s % id))) end if @@ -224,16 +229,16 @@ contains ! Write boundary condition select case (s % bc) case (BC_TRANSMIT) - call write_data("transmission", "boundary_condition", & + call su % write_data("transmission", "boundary_condition", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (BC_VACUUM) - call write_data("vacuum", "boundary_condition", & + call su % write_data("vacuum", "boundary_condition", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (BC_REFLECT) - call write_data("reflective", "boundary_condition", & + call su % write_data("reflective", "boundary_condition", & group="geometry/surfaces/surface " // trim(to_str(s % id))) case (BC_PERIODIC) - call write_data("periodic", "boundary_condition", & + call su % write_data("periodic", "boundary_condition", & group="geometry/surfaces/surface " // trim(to_str(s % id))) end select @@ -243,8 +248,8 @@ contains ! WRITE INFORMATION ON UNIVERSES ! Create universes group (nothing directly written here) then close - call hdf5_open_group("geometry/universes") - call hdf5_close_group() + call hdf5_open_group(su % hdf5_fh, "geometry/universes", su % hdf5_grp) + call hdf5_close_group(su % hdf5_grp) ! Write information on each universe UNIVERSE_LOOP: do i = 1, n_universes @@ -252,7 +257,7 @@ contains ! Write list of cells in this universe if (u % n_cells > 0) then - call write_data(u % cells, "cells", length=u % n_cells, & + call su % write_data(u % cells, "cells", length=u % n_cells, & group="geometry/universes/universe " // trim(to_str(u % id))) end if @@ -262,8 +267,8 @@ contains ! WRITE INFORMATION ON LATTICES ! Create lattices group (nothing directly written here) then close - call hdf5_open_group("geometry/lattices") - call hdf5_close_group() + call hdf5_open_group(su % hdf5_fh, "geometry/lattices", su % hdf5_grp) + call hdf5_close_group(su % hdf5_grp) ! Write information on each lattice LATTICE_LOOP: do i = 1, n_lattices @@ -272,21 +277,21 @@ contains ! Write lattice type select case(lat % type) case (LATTICE_RECT) - call write_data("rectangular", "type", & + call su % write_data("rectangular", "type", & group="geometry/lattices/lattice " // trim(to_str(lat % id))) case (LATTICE_HEX) - call write_data("hexagonal", "type", & + call su % write_data("hexagonal", "type", & group="geometry/lattices/lattice " // trim(to_str(lat % id))) end select ! Write lattice dimensions, lower left corner, and width of element - call write_data(lat % dimension, "dimension", & + call su % write_data(lat % dimension, "dimension", & length=lat % n_dimension, & group="geometry/lattices/lattice " // trim(to_str(lat % id))) - call write_data(lat % lower_left, "lower_left", & + call su % write_data(lat % lower_left, "lower_left", & length=lat % n_dimension, & group="geometry/lattices/lattice " // trim(to_str(lat % id))) - call write_data(lat % width, "width", & + call su % write_data(lat % width, "width", & length=lat % n_dimension, & group="geometry/lattices/lattice " // trim(to_str(lat % id))) @@ -308,7 +313,7 @@ contains end do end do end do - call write_data(lattice_universes, "universes", & + call su % write_data(lattice_universes, "universes", & length=(/n_x, n_y, n_z/), & group="geometry/lattices/lattice " // trim(to_str(lat % id))) deallocate(lattice_universes) @@ -329,16 +334,16 @@ contains type(Material), pointer :: m => null() ! Use H5LT interface to write number of materials - call write_data(n_materials, "n_materials", group="materials") + call su % write_data(n_materials, "n_materials", group="materials") ! Write information on each material do i = 1, n_materials m => materials(i) ! Write atom density with units - call write_data(m % density, "atom_density", & + call su % write_data(m % density, "atom_density", & group="materials/material " // trim(to_str(m % id))) - call write_attribute_string("atom_density", "units", "atom/b-cm", & + call su % write_attribute_string("atom_density", "units", "atom/b-cm", & group="materials/material " // trim(to_str(m % id))) ! Copy ZAID for each nuclide to temporary array @@ -348,23 +353,23 @@ contains end do ! Write temporary array to 'nuclides' - call write_data(zaids, "nuclides", length=m % n_nuclides, & + call su % write_data(zaids, "nuclides", length=m % n_nuclides, & group="materials/material " // trim(to_str(m % id))) ! Deallocate temporary array deallocate(zaids) ! Write atom densities - call write_data(m % atom_density, "nuclide_densities", & + call su % write_data(m % atom_density, "nuclide_densities", & length=m % n_nuclides, & group="materials/material " // trim(to_str(m % id))) ! Write S(a,b) information if present if (m % n_sab > 0) then - call write_data(m % i_sab_nuclides, "i_sab_nuclides", & + call su % write_data(m % i_sab_nuclides, "i_sab_nuclides", & length=m % n_sab, & group="materials/material " // trim(to_str(m % id))) - call write_data(m % i_sab_tables, "i_sab_tables", & + call su % write_data(m % i_sab_tables, "i_sab_tables", & length=m % n_sab, & group="materials/material " // trim(to_str(m % id))) end if @@ -385,72 +390,72 @@ contains type(TallyObject), pointer :: t => null() ! Write total number of meshes - call write_data(n_meshes, "n_meshes", group="tallies") + call su % write_data(n_meshes, "n_meshes", group="tallies") ! Write information for meshes MESH_LOOP: do i = 1, n_meshes m => meshes(i) ! Write type and number of dimensions - call write_data(m % type, "type", & + call su % write_data(m % type, "type", & group="tallies/mesh " // trim(to_str(m % id))) - call write_data(m % n_dimension, "n_dimension", & + call su % write_data(m % n_dimension, "n_dimension", & group="tallies/mesh " // trim(to_str(m % id))) ! Write mesh information - call write_data(m % dimension, "dimension", & + call su % write_data(m % dimension, "dimension", & length=m % n_dimension, & group="tallies/mesh " // trim(to_str(m % id))) - call write_data(m % lower_left, "lower_left", & + call su % write_data(m % lower_left, "lower_left", & length=m % n_dimension, & group="tallies/mesh " // trim(to_str(m % id))) - call write_data(m % upper_right, "upper_right", & + call su % write_data(m % upper_right, "upper_right", & length=m % n_dimension, & group="tallies/mesh " // trim(to_str(m % id))) - call write_data(m % width, "width", & + call su % write_data(m % width, "width", & length=m % n_dimension, & group="tallies/mesh " // trim(to_str(m % id))) end do MESH_LOOP ! Write number of tallies - call write_data(n_tallies, "n_tallies", group="tallies") + call su % write_data(n_tallies, "n_tallies", group="tallies") TALLY_METADATA: do i = 1, n_tallies ! Get pointer to tally t => tallies(i) ! Write size of each tally - call write_data(t % total_score_bins, "total_score_bins", & + call su % write_data(t % total_score_bins, "total_score_bins", & group="tallies/tally " // trim(to_str(t % id))) - call write_data(t % total_filter_bins, "total_filter_bins", & + call su % write_data(t % total_filter_bins, "total_filter_bins", & group="tallies/tally " // trim(to_str(t % id))) ! Write number of filters - call write_data(t % n_filters, "n_filters", & + call su % write_data(t % n_filters, "n_filters", & group="tallies/tally " // trim(to_str(t % id))) FILTER_LOOP: do j = 1, t % n_filters ! Write type of filter - call write_data(t % filters(j) % type, "type", & + call su % write_data(t % filters(j) % type, "type", & group="tallies/tally " // trim(to_str(t % id)) & // "/filter " // trim(to_str(j))) ! Write number of bins for this filter - call write_data(t % filters(j) % n_bins, "n_bins", & + call su % write_data(t % filters(j) % n_bins, "n_bins", & group="tallies/tally " // trim(to_str(t % id)) & // "/filter " // trim(to_str(j))) ! Write filter bins if (t % filters(j) % type == FILTER_ENERGYIN .or. & t % filters(j) % type == FILTER_ENERGYOUT) then - call write_data(t % filters(j) % real_bins, "bins", & + call su % write_data(t % filters(j) % real_bins, "bins", & length=size(t % filters(j) % real_bins), & group="tallies/tally " // trim(to_str(t % id)) & // "/filter " // trim(to_str(j))) else - call write_data(t % filters(j) % int_bins, "bins", & + call su % write_data(t % filters(j) % int_bins, "bins", & length=size(t % filters(j) % int_bins), & group="tallies/tally " // trim(to_str(t % id)) & // "/filter " // trim(to_str(j))) @@ -459,35 +464,35 @@ contains ! Write name of type select case (t % filters(j) % type) case(FILTER_UNIVERSE) - call write_data("universe", "type_name", & + call su % write_data("universe", "type_name", & group="tallies/tally " // trim(to_str(t % id)) & // "/filter " // trim(to_str(j))) case(FILTER_MATERIAL) - call write_data("material", "type_name", & + call su % write_data("material", "type_name", & group="tallies/tally " // trim(to_str(t % id)) & // "/filter " // trim(to_str(j))) case(FILTER_CELL) - call write_data("cell", "type_name", & + call su % write_data("cell", "type_name", & group="tallies/tally " // trim(to_str(t % id)) & // "/filter " // trim(to_str(j))) case(FILTER_CELLBORN) - call write_data("cellborn", "type_name", & + call su % write_data("cellborn", "type_name", & group="tallies/tally " // trim(to_str(t % id)) & // "/filter " // trim(to_str(j))) case(FILTER_SURFACE) - call write_data("surface", "type_name", & + call su % write_data("surface", "type_name", & group="tallies/tally " // trim(to_str(t % id)) & // "/filter " // trim(to_str(j))) case(FILTER_MESH) - call write_data("mesh", "type_name", & + call su % write_data("mesh", "type_name", & group="tallies/tally " // trim(to_str(t % id)) & // "/filter " // trim(to_str(j))) case(FILTER_ENERGYIN) - call write_data("energy", "type_name", & + call su % write_data("energy", "type_name", & group="tallies/tally " // trim(to_str(t % id)) & // "/filter " // trim(to_str(j))) case(FILTER_ENERGYOUT) - call write_data("energyout", "type_name", & + call su % write_data("energyout", "type_name", & group="tallies/tally " // trim(to_str(t % id)) & // "/filter " // trim(to_str(j))) end select @@ -495,7 +500,7 @@ contains end do FILTER_LOOP ! Write number of nuclide bins - call write_data(t % n_nuclide_bins, "n_nuclide_bins", & + call su % write_data(t % n_nuclide_bins, "n_nuclide_bins", & group="tallies/tally " // trim(to_str(t % id))) ! Create temporary array for nuclide bins @@ -509,14 +514,14 @@ contains end do NUCLIDE_LOOP ! Write and deallocate nuclide bins - call write_data(temp_array, "nuclide_bins", length=t % n_nuclide_bins, & + call su % write_data(temp_array, "nuclide_bins", length=t % n_nuclide_bins, & group="tallies/tally " // trim(to_str(t % id))) deallocate(temp_array) ! Write number of score bins - call write_data(t % n_score_bins, "n_score_bins", & + call su % write_data(t % n_score_bins, "n_score_bins", & group="tallies/tally " // trim(to_str(t % id))) - call write_data(t % score_bins, "score_bins", length=t % n_score_bins, & + call su % write_data(t % score_bins, "score_bins", length=t % n_score_bins, & group="tallies/tally " // trim(to_str(t % id))) end do TALLY_METADATA @@ -539,7 +544,7 @@ contains type(UrrData), pointer :: urr => null() ! Use H5LT interface to write number of nuclides - call write_data(n_nuclides_total, "n_nuclides", group="nuclides") + call su % write_data(n_nuclides_total, "n_nuclides", group="nuclides") ! Write information on each nuclide NUCLIDE_LOOP: do i = 1, n_nuclides_total @@ -550,27 +555,28 @@ contains size_total = size_xs ! Write some basic attributes - call write_data(nuc % zaid, "zaid", & + call su % write_data(nuc % zaid, "zaid", & group="nuclides/" // trim(nuc % name)) - call write_data(nuc % awr, "awr", & + call su % write_data(nuc % awr, "awr", & group="nuclides/" // trim(nuc % name)) - call write_data(nuc % kT, "kT", & + call su % write_data(nuc % kT, "kT", & group="nuclides/" // trim(nuc % name)) - call write_data(nuc % n_grid, "n_grid", & + call su % write_data(nuc % n_grid, "n_grid", & group="nuclides/" // trim(nuc % name)) - call write_data(nuc % n_reaction, "n_reactions", & + call su % write_data(nuc % n_reaction, "n_reactions", & group="nuclides/" // trim(nuc % name)) - call write_data(nuc % n_fission, "n_fission", & + call su % write_data(nuc % n_fission, "n_fission", & group="nuclides/" // trim(nuc % name)) - call write_data(size_xs, "size_xs", & + call su % write_data(size_xs, "size_xs", & group="nuclides/" // trim(nuc % name)) ! ======================================================================= ! WRITE INFORMATION ON EACH REACTION ! Create overall group for reactions and close it - call hdf5_open_group("nuclides/" // trim(nuc % name) // "/reactions") - call hdf5_close_group() + call hdf5_open_group(su % hdf5_fh, "nuclides/" // trim(nuc % name) // & + "/reactions", su % hdf5_grp) + call hdf5_close_group(su % hdf5_grp) RXN_LOOP: do j = 1, nuc % n_reaction ! Information on each reaction @@ -591,19 +597,19 @@ contains end if ! Write information on reaction - call write_data(rxn % Q_value, "Q_value", & + call su % write_data(rxn % Q_value, "Q_value", & group="nuclides/" // trim(nuc % name) // "/reactions/" // & trim(reaction_name(rxn % MT))) - call write_data(rxn % multiplicity, "multiplicity", & + call su % write_data(rxn % multiplicity, "multiplicity", & group="nuclides/" // trim(nuc % name) // "/reactions/" // & trim(reaction_name(rxn % MT))) - call write_data(rxn % threshold, "threshold", & + call su % write_data(rxn % threshold, "threshold", & group="nuclides/" // trim(nuc % name) // "/reactions/" // & trim(reaction_name(rxn % MT))) - call write_data(size_angle, "size_angle", & + call su % write_data(size_angle, "size_angle", & group="nuclides/" // trim(nuc % name) // "/reactions/" // & trim(reaction_name(rxn % MT))) - call write_data(size_energy, "size_energy", & + call su % write_data(size_energy, "size_energy", & group="nuclides/" // trim(nuc % name) // "/reactions/" // & trim(reaction_name(rxn % MT))) @@ -616,24 +622,24 @@ contains if (nuc % urr_present) then urr => nuc % urr_data - call write_data(urr % n_energy, "urr_n_energy", & + call su % write_data(urr % n_energy, "urr_n_energy", & group="nuclides/" // trim(nuc % name)) - call write_data(urr % n_prob, "urr_n_prob", & + call su % write_data(urr % n_prob, "urr_n_prob", & group="nuclides/" // trim(nuc % name)) - call write_data(urr % interp, "urr_interp", & + call su % write_data(urr % interp, "urr_interp", & group="nuclides/" // trim(nuc % name)) - call write_data(urr % inelastic_flag, "urr_inelastic", & + call su % write_data(urr % inelastic_flag, "urr_inelastic", & group="nuclides/" // trim(nuc % name)) - call write_data(urr % absorption_flag, "urr_absorption", & + call su % write_data(urr % absorption_flag, "urr_absorption", & group="nuclides/" // trim(nuc % name)) - call write_data(urr % energy(1), "urr_min_E", & + call su % write_data(urr % energy(1), "urr_min_E", & group="nuclides/" // trim(nuc % name)) - call write_data(urr % energy(urr % n_energy), "urr_max_E", & + call su % write_data(urr % energy(urr % n_energy), "urr_max_E", & group="nuclides/" // trim(nuc % name)) end if ! Write total memory used - call write_data(size_total, "size_total", & + call su % write_data(size_total, "size_total", & group="nuclides/" // trim(nuc % name)) end do NUCLIDE_LOOP @@ -650,63 +656,63 @@ contains real(8) :: speed ! Write timing data - call write_data(time_initialize % elapsed, "time_initialize", & + call su % write_data(time_initialize % elapsed, "time_initialize", & group="timing") - call write_data(time_read_xs % elapsed, "time_read_xs", & + call su % write_data(time_read_xs % elapsed, "time_read_xs", & group="timing") - call write_data(time_unionize % elapsed, "time_unionize", & + call su % write_data(time_unionize % elapsed, "time_unionize", & group="timing") - call write_data(time_transport % elapsed, "time_transport", & + call su % write_data(time_transport % elapsed, "time_transport", & group="timing") - call write_data(time_bank % elapsed, "time_bank", & + call su % write_data(time_bank % elapsed, "time_bank", & group="timing") - call write_data(time_bank_sample % elapsed, "time_bank_sample", & + call su % write_data(time_bank_sample % elapsed, "time_bank_sample", & group="timing") - call write_data(time_bank_sendrecv % elapsed, "time_bank_sendrecv", & + call su % write_data(time_bank_sendrecv % elapsed, "time_bank_sendrecv", & group="timing") - call write_data(time_tallies % elapsed, "time_tallies", & + call su % write_data(time_tallies % elapsed, "time_tallies", & group="timing") - call write_data(time_inactive % elapsed, "time_inactive", & + call su % write_data(time_inactive % elapsed, "time_inactive", & group="timing") - call write_data(time_active % elapsed, "time_active", & + call su % write_data(time_active % elapsed, "time_active", & group="timing") - call write_data(time_finalize % elapsed, "time_finalize", & + call su % write_data(time_finalize % elapsed, "time_finalize", & group="timing") - call write_data(time_total % elapsed, "time_total", & + call su % write_data(time_total % elapsed, "time_total", & group="timing") ! Add descriptions to timing data - call write_attribute_string("time_initialize", "description", & + call su % write_attribute_string("time_initialize", "description", & "Total time elapsed for initialization (s)", group="timing") - call write_attribute_string("time_read_xs", "description", & + call su % write_attribute_string("time_read_xs", "description", & "Time reading cross-section libraries (s)", group="timing") - call write_attribute_string("time_unionize", "description", & + call su % write_attribute_string("time_unionize", "description", & "Time unionizing energy grid (s)", group="timing") - call write_attribute_string("time_transport", "description", & + call su % write_attribute_string("time_transport", "description", & "Time in transport only (s)", group="timing") - call write_attribute_string("time_bank", "description", & + call su % write_attribute_string("time_bank", "description", & "Total time synchronizing fission bank (s)", group="timing") - call write_attribute_string("time_bank_sample", "description", & + call su % write_attribute_string("time_bank_sample", "description", & "Time between generations sampling source sites (s)", group="timing") - call write_attribute_string("time_bank_sendrecv", "description", & + call su % write_attribute_string("time_bank_sendrecv", "description", & "Time between generations SEND/RECVing source sites (s)", & group="timing") - call write_attribute_string("time_tallies", "description", & + call su % write_attribute_string("time_tallies", "description", & "Time between batches accumulating tallies (s)", group="timing") - call write_attribute_string("time_inactive", "description", & + call su % write_attribute_string("time_inactive", "description", & "Total time in inactive batches (s)", group="timing") - call write_attribute_string("time_active", "description", & + call su % write_attribute_string("time_active", "description", & "Total time in active batches (s)", group="timing") - call write_attribute_string("time_finalize", "description", & + call su % write_attribute_string("time_finalize", "description", & "Total time for finalization (s)", group="timing") - call write_attribute_string("time_total", "description", & + call su % write_attribute_string("time_total", "description", & "Total time elapsed (s)", group="timing") ! Write calculation rate total_particles = n_particles * n_batches * gen_per_batch speed = real(total_particles) / (time_inactive % elapsed + & time_active % elapsed) - call write_data(speed, "neutrons_per_second", group="timing") + call su % write_data(speed, "neutrons_per_second", group="timing") end subroutine hdf5_write_timing diff --git a/src/initialize.F90 b/src/initialize.F90 index da9194915c..e6107658f0 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -14,7 +14,7 @@ module initialize use output, only: title, header, write_summary, print_version, & print_usage, write_xs_summary, print_plot, & write_message - use output_interface, only: file_open, file_close, read_data + use output_interface use random_lcg, only: initialize_prng use source, only: initialize_source use state_point, only: load_state_point @@ -303,6 +303,7 @@ contains integer :: filetype character(MAX_FILE_LEN) :: pwd ! present working directory character(MAX_WORD_LEN), allocatable :: argv(:) ! command line arguments + type(BinaryOutput) :: sp ! Get working directory call GET_ENVIRONMENT_VARIABLE("PWD", pwd) @@ -343,9 +344,9 @@ contains i = i + 1 ! Check what type of file this is - call file_open(argv(i), 'parallel', 'r') - call read_data(filetype, 'filetype') - call file_close('parallel') + call sp % file_open(argv(i), 'r') + call sp % read_data(filetype, 'filetype') + call sp % file_close() ! Set path and flag for type of run select case (filetype) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index a5ebcfacbf..7f398c333e 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -15,7 +15,6 @@ module output_interface private type, public :: BinaryOutput - private ! Compilation specific data #ifdef HDF5 integer(HID_T) :: hdf5_fh @@ -34,7 +33,9 @@ module output_interface write_integer_1Darray, & write_integer_2Darray, & write_integer_3Darray, & - write_integer_4Darray + write_integer_4Darray, & + write_long, & + write_string generic, public :: read_data => read_double, & read_double_1Darray, & read_double_2Darray, & @@ -44,7 +45,12 @@ module output_interface read_integer_1Darray, & read_integer_2Darray, & read_integer_3Darray, & - read_integer_4Darray + read_integer_4Darray, & + read_long, & + read_string + procedure, public :: file_create => file_create + procedure, public :: file_open => file_open + procedure, public :: file_close => file_close procedure, public :: write_double => write_double procedure, public :: write_double_1Darray => write_double_1Darray procedure, public :: write_double_2Darray => write_double_2Darray @@ -55,16 +61,20 @@ module output_interface procedure, public :: write_integer_2Darray => write_integer_2Darray procedure, public :: write_integer_3Darray => write_integer_3Darray procedure, public :: write_integer_4Darray => write_integer_4Darray + procedure, public :: write_long => write_long + procedure, public :: write_string => write_string procedure, public :: read_double => read_double procedure, public :: read_double_1Darray => read_double_1Darray procedure, public :: read_double_2Darray => read_double_2Darray procedure, public :: read_double_3Darray => read_double_3Darray procedure, public :: read_double_4Darray => read_double_4Darray - procedure, public :: read_integer => read_double - procedure, public :: read_integer_1Darray => read_double_1Darray - procedure, public :: read_integer_2Darray => read_double_2Darray - procedure, public :: read_integer_3Darray => read_double_3Darray - procedure, public :: read_integer_4Darray => read_double_4Darray + procedure, public :: read_integer => read_integer + procedure, public :: read_integer_1Darray => read_integer_1Darray + procedure, public :: read_integer_2Darray => read_integer_2Darray + procedure, public :: read_integer_3Darray => read_integer_3Darray + procedure, public :: read_integer_4Darray => read_integer_4Darray + procedure, public :: read_long => read_long + procedure, public :: read_string => read_string procedure, public :: write_attribute_string => write_attribute_string procedure, public :: write_tally_result => write_tally_result procedure, public :: read_tally_result => read_tally_result @@ -81,7 +91,7 @@ contains subroutine file_create(self, filename, serial, unit) character(*), intent(in) :: filename ! name of file to be created - integer, intent(in) :: unit ! optional unit number + integer, optional, intent(in) :: unit ! optional unit number logical, optional, intent(in) :: serial ! processor rank to write from class(BinaryOutput) :: self @@ -97,7 +107,7 @@ contains if (self % serial) then call hdf5_file_create(filename, self % hdf5_fh) else - call hdf5_parallel_file_create(filename, self % hdf5_fh) + call hdf5_file_create_parallel(filename, self % hdf5_fh) endif # else call hdf5_file_create(filename, self % hdf5_fh) @@ -137,7 +147,7 @@ contains character(*), intent(in) :: filename ! name of file to be opened character(*), intent(in) :: mode ! file access mode - integer, intent(in) :: unit ! optional unit number + integer, optional, intent(in) :: unit ! optional unit number logical, optional, intent(in) :: serial ! processor rank to write from class(BinaryOutput) :: self @@ -153,7 +163,7 @@ contains if (self % serial) then call hdf5_file_open(filename, self % hdf5_fh, mode) else - call hdf5_parallel_file_open(filename, self % hdf5_fh, mode) + call hdf5_file_open_parallel(filename, self % hdf5_fh, mode) endif # else call hdf5_file_open(filename, self % hdf5_fh, mode) diff --git a/src/state_point.F90 b/src/state_point.F90 index 5020f8f3d0..b86a0c6e59 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -22,6 +22,8 @@ module state_point implicit none + type(BinaryOutput) :: sp ! statepoint/source output file + contains !=============================================================================== @@ -51,78 +53,78 @@ contains message = "Creating state point " // trim(filename) // "..." call write_message(1) - ! Create statepoint file - call file_create(filename, 'serial') - if (master) then + ! Create statepoint file + call sp % file_create(filename, serial=.true.) + ! Write file type - call write_data(FILETYPE_STATEPOINT, "filetype") + call sp % write_data(FILETYPE_STATEPOINT, "filetype") ! Write revision number for state point file - call write_data(REVISION_STATEPOINT, "revision") + call sp % write_data(REVISION_STATEPOINT, "revision") ! Write OpenMC version - call write_data(VERSION_MAJOR, "version_major") - call write_data(VERSION_MINOR, "version_minor") - call write_data(VERSION_RELEASE, "version_release") + call sp % write_data(VERSION_MAJOR, "version_major") + call sp % write_data(VERSION_MINOR, "version_minor") + call sp % write_data(VERSION_RELEASE, "version_release") ! Write current date and time - call write_data(time_stamp(), "date_and_time") + call sp % write_data(time_stamp(), "date_and_time") ! Write path to input - call write_data(path_input, "path") + call sp % write_data(path_input, "path") ! Write out random number seed - call write_data(seed, "seed") + call sp % write_data(seed, "seed") ! Write run information - call write_data(run_mode, "run_mode") - call write_data(n_particles, "n_particles") - call write_data(n_batches, "n_batches") + call sp % write_data(run_mode, "run_mode") + call sp % write_data(n_particles, "n_particles") + call sp % write_data(n_batches, "n_batches") ! Write out current batch number - call write_data(current_batch, "current_batch") + call sp % write_data(current_batch, "current_batch") ! Write out information for eigenvalue run if (run_mode == MODE_EIGENVALUE) then - call write_data(n_inactive, "n_inactive") - call write_data(gen_per_batch, "gen_per_batch") - call write_data(k_generation, "k_generation", & + call sp % write_data(n_inactive, "n_inactive") + call sp % write_data(gen_per_batch, "gen_per_batch") + call sp % write_data(k_generation, "k_generation", & length=current_batch*gen_per_batch) - call write_data(entropy, "entropy", length=current_batch*gen_per_batch) - call write_data(k_col_abs, "k_col_abs") - call write_data(k_col_tra, "k_col_tra") - call write_data(k_abs_tra, "k_abs_tra") - call write_data(k_combined, "k_combined", length=2) + call sp % write_data(entropy, "entropy", length=current_batch*gen_per_batch) + call sp % write_data(k_col_abs, "k_col_abs") + call sp % write_data(k_col_tra, "k_col_tra") + call sp % write_data(k_abs_tra, "k_abs_tra") + call sp % write_data(k_combined, "k_combined", length=2) end if ! Write number of meshes - call write_data(n_meshes, "n_meshes", group="tallies") + call sp % write_data(n_meshes, "n_meshes", group="tallies") ! Write information for meshes MESH_LOOP: do i = 1, n_meshes - call write_data(meshes(i) % id, "id", & + call sp % write_data(meshes(i) % id, "id", & group="tallies/mesh" // to_str(i)) - call write_data(meshes(i) % type, "type", & + call sp % write_data(meshes(i) % type, "type", & group="tallies/mesh" // to_str(i)) - call write_data(meshes(i) % n_dimension, "n_dimension", & + call sp % write_data(meshes(i) % n_dimension, "n_dimension", & group="tallies/mesh" // to_str(i)) - call write_data(meshes(i) % dimension, "dimension", & + call sp % write_data(meshes(i) % dimension, "dimension", & group="tallies/mesh" // to_str(i), & length=meshes(i) % n_dimension) - call write_data(meshes(i) % lower_left, "lower_left", & + call sp % write_data(meshes(i) % lower_left, "lower_left", & group="tallies/mesh" // to_str(i), & length=meshes(i) % n_dimension) - call write_data(meshes(i) % upper_right, "upper_right", & + call sp % write_data(meshes(i) % upper_right, "upper_right", & group="tallies/mesh" // to_str(i), & length=meshes(i) % n_dimension) - call write_data(meshes(i) % width, "width", & + call sp % write_data(meshes(i) % width, "width", & group="tallies/mesh" // to_str(i), & length=meshes(i) % n_dimension) end do MESH_LOOP ! Write number of tallies - call write_data(n_tallies, "n_tallies", group="tallies") + call sp % write_data(n_tallies, "n_tallies", group="tallies") ! Write all tally information except results TALLY_METADATA: do i = 1, n_tallies @@ -130,41 +132,41 @@ contains t => tallies(i) ! Write id - call write_data(t % id, "id", group="tallies/tally" // to_str(i)) + call sp % write_data(t % id, "id", group="tallies/tally" // to_str(i)) ! Write number of realizations - call write_data(t % n_realizations, "n_realizations", & + call sp % write_data(t % n_realizations, "n_realizations", & group="tallies/tally" // to_str(i)) ! Write size of each tally - call write_data(t % total_score_bins, "total_score_bins", & + call sp % write_data(t % total_score_bins, "total_score_bins", & group="tallies/tally" // to_str(i)) - call write_data(t % total_filter_bins, "total_filter_bins", & + call sp % write_data(t % total_filter_bins, "total_filter_bins", & group="tallies/tally" // to_str(i)) ! Write number of filters - call write_data(t % n_filters, "n_filters", & + call sp % write_data(t % n_filters, "n_filters", & group="tallies/tally" // to_str(i)) ! Write filter information FILTER_LOOP: do j = 1, t % n_filters ! Write type of filter - call write_data(t % filters(j) % type, "type", & + call sp % write_data(t % filters(j) % type, "type", & group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j)) ! Write number of bins for this filter - call write_data(t % filters(j) % n_bins, "n_bins", & + call sp % write_data(t % filters(j) % n_bins, "n_bins", & group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j)) ! Write bins if (t % filters(j) % type == FILTER_ENERGYIN .or. & t % filters(j) % type == FILTER_ENERGYOUT) then - call write_data(t % filters(j) % real_bins, "bins", & + call sp % write_data(t % filters(j) % real_bins, "bins", & group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j), & length=size(t % filters(j) % real_bins)) else - call write_data(t % filters(j) % int_bins, "bins", & + call sp % write_data(t % filters(j) % int_bins, "bins", & group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j), & length=size(t % filters(j) % int_bins)) end if @@ -172,7 +174,7 @@ contains end do FILTER_LOOP ! Write number of nuclide bins - call write_data(t % n_nuclide_bins, "n_nuclide_bins", & + call sp % write_data(t % n_nuclide_bins, "n_nuclide_bins", & group="tallies/tally" // to_str(i)) ! Set up nuclide bin array and then write @@ -184,20 +186,20 @@ contains temp_array(j) = t % nuclide_bins(j) end if end do NUCLIDE_LOOP - call write_data(temp_array, "nuclide_bins", & + call sp % write_data(temp_array, "nuclide_bins", & group="tallies/tally" // to_str(i), length=t % n_nuclide_bins) deallocate(temp_array) ! Write number of score bins, score bins, and scatt order - call write_data(t % n_score_bins, "n_score_bins", & + call sp % write_data(t % n_score_bins, "n_score_bins", & group="tallies/tally" // to_str(i)) - call write_data(t % score_bins, "score_bins", & + call sp % write_data(t % score_bins, "score_bins", & group="tallies/tally" // to_str(i), length=t % n_score_bins) - call write_data(t % scatt_order, "scatt_order", & + call sp % write_data(t % scatt_order, "scatt_order", & group="tallies/tally" // to_str(i), length=t % n_score_bins) ! Write number of user score bins - call write_data(t % n_user_score_bins, "n_user_score_bins", & + call sp % write_data(t % n_user_score_bins, "n_user_score_bins", & group="tallies/tally" // to_str(i)) end do TALLY_METADATA @@ -214,18 +216,18 @@ contains elseif (master) then ! Write number of global realizations - call write_data(n_realizations, "n_realizations") + call sp % write_data(n_realizations, "n_realizations") ! Write global tallies - call write_data(N_GLOBAL_TALLIES, "n_global_tallies") - call write_tally_result(global_tallies, "global_tallies", & + call sp % write_data(N_GLOBAL_TALLIES, "n_global_tallies") + call sp % write_tally_result(global_tallies, "global_tallies", & n1=N_GLOBAL_TALLIES, n2=1) ! Write tallies if (tallies_on) then ! Indicate that tallies are on - call write_data(1, "tallies_present", group="tallies") + call sp % write_data(1, "tallies_present", group="tallies") ! Write all tally results TALLY_RESULTS: do i = 1, n_tallies @@ -234,7 +236,7 @@ contains t => tallies(i) ! Write sum and sum_sq for each bin - call write_tally_result(t % results, "results", & + call sp % write_tally_result(t % results, "results", & group="tallies/tally" // to_str(i), & n1=size(t % results, 1), n2=size(t % results, 2)) @@ -243,10 +245,13 @@ contains else ! Indicate tallies are off - call write_data(0, "tallies_present", group="tallies") + call sp % write_data(0, "tallies_present", group="tallies") end if + ! Close the file for serial writing + call sp % file_close() + end if ! Check for eigenvalue calculation @@ -255,9 +260,6 @@ contains ! Check for writing source out separately if (source_separate) then - ! Close statepoint file - call file_close('serial') - ! Set filename for source filename = trim(path_output) // 'source.' // & trim(to_str(current_batch)) @@ -272,29 +274,23 @@ contains call write_message(1) ! Create statepoint file - call file_create(filename, 'parallel') + call sp % file_create(filename) #ifdef HDF5 # ifdef MPI else - ! Close HDF5 serial file and reopen in parallel - call file_close('serial') - call file_open(filename, 'parallel', 'w') + ! Reopen state point file in parallel + call sp % file_open(filename, 'w') # endif #endif end if ! Write out source - call write_source_bank() + call sp % write_source_bank() - ! Close file, all files in parallel mode - call file_close('parallel') ! even if no MPI, this will work for HDF5 - - else - - ! Close file if not in eigenvalue mode or no source writing - call file_close('serial') + ! Close file + call sp % file_close() end if @@ -323,10 +319,10 @@ contains if (master) then ! Write number of realizations - call write_data(n_realizations, "n_realizations") + call sp % write_data(n_realizations, "n_realizations") ! Write number of global tallies - call write_data(N_GLOBAL_TALLIES, "n_global_tallies") + call sp % write_data(N_GLOBAL_TALLIES, "n_global_tallies") end if ! Copy global tallies into temporary array for reducing @@ -355,7 +351,7 @@ contains ! Write out global tallies sum and sum_sq - call write_tally_result(tallyresult_temp, "global_tallies", & + call sp % write_tally_result(tallyresult_temp, "global_tallies", & n1=N_GLOBAL_TALLIES, n2=1) ! Deallocate temporary tally result @@ -371,7 +367,7 @@ contains if (tallies_on) then ! Indicate that tallies are on if (master) then - call write_data(1, "tallies_present", group="tallies") + call sp % write_data(1, "tallies_present", group="tallies") end if ! Write all tally results @@ -409,7 +405,7 @@ contains tallyresult_temp(:,:) % sum_sq = tally_temp(2,:,:) ! Write reduced tally results to file - call write_tally_result(t % results, "results", & + call sp % write_tally_result(t % results, "results", & group="tallies/tally" // to_str(i), n1=m, n2=n) ! Deallocate temporary tally result @@ -428,7 +424,7 @@ contains else if (master) then ! Indicate that tallies are off - call write_data(0, "tallies_present", group="tallies") + call sp % write_data(0, "tallies_present", group="tallies") end if end if @@ -455,14 +451,14 @@ contains call write_message(1) ! Open file for reading - call file_open(path_state_point, 'parallel', 'r') + call sp % file_open(path_state_point, 'r') ! Read filetype - call read_data(int_array(1), "filetype", option="collective") + call sp % read_data(int_array(1), "filetype") ! Read revision number for state point file and make sure it matches with ! current version - call read_data(int_array(1), "revision", option="collective") + call sp % read_data(int_array(1), "revision") if (int_array(1) /= REVISION_STATEPOINT) then message = "State point version does not match current version " & // "in OpenMC." @@ -470,9 +466,9 @@ contains end if ! Read OpenMC version - call read_data(int_array(1), "version_major", option="collective") - call read_data(int_array(2), "version_minor", option="collective") - call read_data(int_array(3), "version_release", option="collective") + call sp % read_data(int_array(1), "version_major") + call sp % read_data(int_array(2), "version_minor") + call sp % read_data(int_array(3), "version_release") if (int_array(1) /= VERSION_MAJOR .or. int_array(2) /= VERSION_MINOR & .or. int_array(3) /= VERSION_RELEASE) then message = "State point file was created with a different version " & @@ -481,70 +477,68 @@ contains end if ! Read date and time - call read_data(current_time, "date_and_time", option="collective") + call sp % read_data(current_time, "date_and_time") ! Read path to input - call read_data(path_temp, "path", option="collective") + call sp % read_data(path_temp, "path") ! Read and overwrite random number seed - call read_data(seed, "seed", option="collective") + call sp % read_data(seed, "seed") ! Read and overwrite run information except number of batches - call read_data(run_mode, "run_mode", option="collective") - call read_data(n_particles, "n_particles", option="collective") - call read_data(int_array(1), "n_batches", option="collective") + call sp % read_data(run_mode, "run_mode") + call sp % read_data(n_particles, "n_particles") + call sp % read_data(int_array(1), "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_data(restart_batch, "current_batch", option="collective") + call sp % read_data(restart_batch, "current_batch") ! Read information specific to eigenvalue run if (run_mode == MODE_EIGENVALUE) then - call read_data(int_array(1), "n_inactive", option="collective") - call read_data(gen_per_batch, "gen_per_batch", option="collective") - call read_data(k_generation, "k_generation", & - length=restart_batch*gen_per_batch, option="collective") - call read_data(entropy, "entropy", length=restart_batch*gen_per_batch, & - option="collective") - call read_data(k_col_abs, "k_col_abs", option="collective") - call read_data(k_col_tra, "k_col_tra", option="collective") - call read_data(k_abs_tra, "k_abs_tra", option="collective") - call read_data(real_array(1:2), "k_combined", length=2, & - option="collective") + call sp % read_data(int_array(1), "n_inactive") + call sp % read_data(gen_per_batch, "gen_per_batch") + call sp % read_data(k_generation, "k_generation", & + length=restart_batch*gen_per_batch) + call sp % read_data(entropy, "entropy", length=restart_batch*gen_per_batch) + call sp % read_data(k_col_abs, "k_col_abs") + call sp % read_data(k_col_tra, "k_col_tra") + call sp % read_data(k_abs_tra, "k_abs_tra") + call sp % read_data(real_array(1:2), "k_combined", length=2) ! Take maximum of statepoint n_inactive and input n_inactive n_inactive = max(n_inactive, int_array(1)) end if ! Read number of meshes - call read_data(n_meshes, "n_meshes", group="tallies", option="collective") + call sp % read_data(n_meshes, "n_meshes", group="tallies") ! Read and overwrite mesh information MESH_LOOP: do i = 1, n_meshes - call read_data(meshes(i) % id, "id", & - group="tallies/mesh" // to_str(i), option="collective") - call read_data(meshes(i) % type, "type", & - group="tallies/mesh" // to_str(i), option="collective") - call read_data(meshes(i) % n_dimension, "n_dimension", & - group="tallies/mesh" // to_str(i), option="collective") - call read_data(meshes(i) % dimension, "dimension", & + call sp % read_data(meshes(i) % id, "id", & + group="tallies/mesh" // to_str(i)) + call sp % read_data(meshes(i) % type, "type", & + group="tallies/mesh" // to_str(i)) + call sp % read_data(meshes(i) % n_dimension, "n_dimension", & + group="tallies/mesh" // to_str(i)) + call sp % read_data(meshes(i) % dimension, "dimension", & group="tallies/mesh" // to_str(i), & - length=meshes(i) % n_dimension, option="collective") - call read_data(meshes(i) % lower_left, "lower_left", & + length=meshes(i) % n_dimension) + call sp % read_data(meshes(i) % lower_left, "lower_left", & group="tallies/mesh" // to_str(i), & - length=meshes(i) % n_dimension, option="collective") - call read_data(meshes(i) % upper_right, "upper_right", & + length=meshes(i) % n_dimension) + call sp % read_data(meshes(i) % upper_right, "upper_right", & group="tallies/mesh" // to_str(i), & - length=meshes(i) % n_dimension, option="collective") - call read_data(meshes(i) % width, "width", & + length=meshes(i) % n_dimension) + call sp % read_data(meshes(i) % width, "width", & group="tallies/mesh" // to_str(i), & - length=meshes(i) % n_dimension, option="collective") + length=meshes(i) % n_dimension) end do MESH_LOOP ! Read and overwrite number of tallies - call read_data(n_tallies, "n_tallies", group="tallies", option="collective") + call sp % read_data(n_tallies, "n_tallies", group="tallies") ! Read in tally metadata TALLY_METADATA: do i = 1, n_tallies @@ -553,18 +547,17 @@ contains t => tallies(i) ! Read tally id - call read_data(t % id, "id", group="tallies/tally" // to_str(i), & - option="collective") + call sp % read_data(t % id, "id", group="tallies/tally" // to_str(i)) ! Read number of realizations - call read_data(t % n_realizations, "n_realizations", & - group="tallies/tally" // to_str(i), option="collective") + call sp % read_data(t % n_realizations, "n_realizations", & + group="tallies/tally" // to_str(i)) ! Read size of tally results - call read_data(int_array(1), "total_score_bins", & - group="tallies/tally" // to_str(i), option="collective") - call read_data(int_array(2), "total_filter_bins", & - group="tallies/tally" // to_str(i), option="collective") + call sp % read_data(int_array(1), "total_score_bins", & + group="tallies/tally" // to_str(i)) + call sp % read_data(int_array(2), "total_filter_bins", & + group="tallies/tally" // to_str(i)) ! Check size of tally results array if (int_array(1) /= t % total_score_bins .and. & @@ -574,45 +567,42 @@ contains end if ! Read number of filters - call read_data(t % n_filters, "n_filters", & - group="tallies/tally" // to_str(i), option="collective") + call sp % read_data(t % n_filters, "n_filters", & + group="tallies/tally" // to_str(i)) ! Read filter information FILTER_LOOP: do j = 1, t % n_filters ! Read type of filter - call read_data(t % filters(j) % type, "type", & - group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j), & - option="collective") + call sp % read_data(t % filters(j) % type, "type", & + group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j)) ! Read number of bins for this filter - call read_data(t % filters(j) % n_bins, "n_bins", & - group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j), & - option="collective") + call sp % read_data(t % filters(j) % n_bins, "n_bins", & + group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j)) ! Read bins if (t % filters(j) % type == FILTER_ENERGYIN .or. & t % filters(j) % type == FILTER_ENERGYOUT) then - call read_data(t % filters(j) % real_bins, "bins", & + call sp % read_data(t % filters(j) % real_bins, "bins", & group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j), & - length=size(t % filters(j) % real_bins), option="collective") + length=size(t % filters(j) % real_bins)) else - call read_data(t % filters(j) % int_bins, "bins", & + call sp % read_data(t % filters(j) % int_bins, "bins", & group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j), & - length=size(t % filters(j) % int_bins), option="collective") + length=size(t % filters(j) % int_bins)) end if end do FILTER_LOOP ! Read number of nuclide bins - call read_data(t % n_nuclide_bins, "n_nuclide_bins", & - group="tallies/tally" // to_str(i), option="collective") + call sp % read_data(t % n_nuclide_bins, "n_nuclide_bins", & + group="tallies/tally" // to_str(i)) ! Set up nuclide bin array and then write allocate(temp_array(t % n_nuclide_bins)) - call read_data(temp_array, "nuclide_bins", & - group="tallies/tally" // to_str(i), length=t % n_nuclide_bins, & - option="collective") + call sp % read_data(temp_array, "nuclide_bins", & + group="tallies/tally" // to_str(i), length=t % n_nuclide_bins) NUCLIDE_LOOP: do j = 1, t % n_nuclide_bins if (temp_array(j) > 0) then nuclides(t % nuclide_bins(j)) % zaid = temp_array(j) @@ -623,18 +613,16 @@ contains deallocate(temp_array) ! Write number of score bins, score bins, and scatt order - call read_data(t % n_score_bins, "n_score_bins", & - group="tallies/tally" // to_str(i), option="collective") - call read_data(t % score_bins, "score_bins", & - group="tallies/tally" // to_str(i), length=t % n_score_bins, & - option="collective") - call read_data(t % scatt_order, "scatt_order", & - group="tallies/tally" // to_str(i), length=t % n_score_bins, & - option="collective") + call sp % read_data(t % n_score_bins, "n_score_bins", & + group="tallies/tally" // to_str(i)) + call sp % read_data(t % score_bins, "score_bins", & + group="tallies/tally" // to_str(i), length=t % n_score_bins) + call sp % read_data(t % scatt_order, "scatt_order", & + group="tallies/tally" // to_str(i), length=t % n_score_bins) ! Write number of user score bins - call read_data(t % n_user_score_bins, "n_user_score_bins", & - group="tallies/tally" // to_str(i), option="collective") + call sp % read_data(t % n_user_score_bins, "n_user_score_bins", & + group="tallies/tally" // to_str(i)) end do TALLY_METADATA @@ -642,21 +630,21 @@ contains if (master) then ! Read number of realizations for global tallies - call read_data(n_realizations, "n_realizations") + call sp % read_data(n_realizations, "n_realizations") ! Read number of global tallies - call read_data(int_array(1), "n_global_tallies") + call sp % read_data(int_array(1), "n_global_tallies") if (int_array(1) /= N_GLOBAL_TALLIES) then message = "Number of global tallies does not match in state point." call fatal_error() end if ! Read global tally data - call read_tally_result(global_tallies, "global_tallies", & + call sp % read_tally_result(global_tallies, "global_tallies", & n1=N_GLOBAL_TALLIES, n2=1) ! Check if tally results are present - call read_data(int_array(1), "tallies_present", group="tallies") + call sp % read_data(int_array(1), "tallies_present", group="tallies") ! Read in sum and sum squared if (int_array(1) == 1) then @@ -666,7 +654,7 @@ contains t => tallies(i) ! Read sum and sum_sq for each bin - call read_tally_result(t % results, "results", & + call sp % read_tally_result(t % results, "results", & group="tallies/tally" // to_str(i), & n1=size(t % results, 1), n2=size(t % results, 2)) @@ -681,7 +669,7 @@ contains if (source_separate) then ! Close statepoint file - call file_close('parallel') + call sp % file_close() ! Set filename for source filename = trim(path_output) // 'source.' // & @@ -696,25 +684,21 @@ contains message = "Loading source file " // trim(filename) // "..." call write_message(1) - ! Create statepoint file - call file_open(filename, 'parallel', 'r') + ! Open source file + call sp % file_open(filename, 'r') end if ! Write out source - call read_source_bank() + call sp % read_source_bank() ! Close file - if (source_separate) then - call file_close('parallel') - else - call file_close('parallel') - end if + call sp % file_close() else ! Close file if not in eigenvalue mode - call file_close('parallel') + call sp % file_close() end if From fbb0f34087ace11d7699aa78c020206882d8cea8 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 1 Aug 2013 06:32:08 -0400 Subject: [PATCH 07/21] fixed wrong group handle in output interface and changed master reads in statepoint to independent I/O --- src/output_interface.F90 | 15 ++++++++++----- src/state_point.F90 | 10 +++++----- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 7f398c333e..a4f614f8ce 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -420,16 +420,16 @@ contains endif # ifdef MPI if (self % serial) then - call hdf5_read_double_1Darray(self % hdf5_fh, name, buffer, length) + call hdf5_read_double_1Darray(self % hdf5_grp, name, buffer, length) else - call hdf5_read_double_1Darray_parallel(self % hdf5_fh, name, buffer, & + call hdf5_read_double_1Darray_parallel(self % hdf5_grp, name, buffer, & length, collect_) end if # else - call hdf5_read_double_1Darray(self % hdf5_fh, name, buffer, length) + call hdf5_read_double_1Darray(self % hdf5_grp, name, buffer, length) # endif ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_fh) + if (present(group)) call hdf5_close_group(self % hdf5_grp) #elif MPI if (self % serial) then read(self % unit_fh) buffer(1:length) @@ -1643,10 +1643,15 @@ contains ! Close ids call h5dclose_f(dset, hdf5_err) if (present(group)) call hdf5_close_group(self % hdf5_grp) +#elif MPI + + ! Read tally result + call MPI_FILE_READ(mpi_fh, buffer, n1*n2, MPI_TALLYRESULT, & + MPI_STATUS_IGNORE, mpiio_err) #else - ! Write out tally buffer + ! Read tally result do k = 1, n2 do j = 1, n1 read(self % unit_fh) buffer(j,k) % sum diff --git a/src/state_point.F90 b/src/state_point.F90 index b86a0c6e59..9a5a1fb46f 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -625,15 +625,15 @@ contains group="tallies/tally" // to_str(i)) end do TALLY_METADATA - +print *, "HERE", rank ! Read tallies to master if (master) then ! Read number of realizations for global tallies - call sp % read_data(n_realizations, "n_realizations") + call sp % read_data(n_realizations, "n_realizations", collect=.false.) ! Read number of global tallies - call sp % read_data(int_array(1), "n_global_tallies") + call sp % read_data(int_array(1), "n_global_tallies", collect=.false.) if (int_array(1) /= N_GLOBAL_TALLIES) then message = "Number of global tallies does not match in state point." call fatal_error() @@ -644,7 +644,7 @@ contains n1=N_GLOBAL_TALLIES, n2=1) ! Check if tally results are present - call sp % read_data(int_array(1), "tallies_present", group="tallies") + call sp % read_data(int_array(1), "tallies_present", group="tallies", collect=.false.) ! Read in sum and sum squared if (int_array(1) == 1) then @@ -661,7 +661,7 @@ contains end do TALLY_RESULTS end if end if - +print *, "HERE1", rank ! Read source if in eigenvalue mode if (run_mode == MODE_EIGENVALUE) then From 9ee239909465c4924ed3da04646d123557c8d7b0 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 1 Aug 2013 06:54:36 -0400 Subject: [PATCH 08/21] fixed serial hdf5 I/O --- src/output_interface.F90 | 4 ++-- src/state_point.F90 | 22 +++++++--------------- 2 files changed, 9 insertions(+), 17 deletions(-) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index a4f614f8ce..add1be9c00 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -1444,7 +1444,7 @@ contains end if # else ! Write the data - call hdf5_write_string(self % hdf5_grp, name, n, buffer) + call hdf5_write_string(self % hdf5_grp, name, buffer, n) # endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) @@ -1499,7 +1499,7 @@ contains call hdf5_read_string_parallel(self % hdf5_grp, name, buffer, n, collect_) end if # else - call hdf5_read_string(self % hdf5_grp, name, n, buffer) + call hdf5_read_string(self % hdf5_grp, name, buffer, n) # endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) diff --git a/src/state_point.F90 b/src/state_point.F90 index 9a5a1fb46f..739d4a36fa 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -276,13 +276,10 @@ contains ! Create statepoint file call sp % file_create(filename) -#ifdef HDF5 -# ifdef MPI else - ! Reopen state point file in parallel + + ! Reopen state point file in parallel call sp % file_open(filename, 'w') -# endif -#endif end if @@ -625,7 +622,7 @@ contains group="tallies/tally" // to_str(i)) end do TALLY_METADATA -print *, "HERE", rank + ! Read tallies to master if (master) then @@ -661,7 +658,7 @@ print *, "HERE", rank end do TALLY_RESULTS end if end if -print *, "HERE1", rank + ! Read source if in eigenvalue mode if (run_mode == MODE_EIGENVALUE) then @@ -692,16 +689,11 @@ print *, "HERE1", rank ! Write out source call sp % read_source_bank() - ! Close file - call sp % file_close() - - else - - ! Close file if not in eigenvalue mode - call sp % file_close() - end if + ! Close file + call sp % file_close() + end subroutine load_state_point subroutine read_source From 825ed00415c51c1d9ac9ab8d739443ce098d2b62 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 1 Aug 2013 07:04:06 -0400 Subject: [PATCH 09/21] fixed compile errors when using MPI I/O --- src/output_interface.F90 | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index add1be9c00..9425e722e1 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -381,7 +381,7 @@ contains if (self % serial) then write(self % unit_fh) buffer(1:length) else - call mpi_write_double_1Darray(self % unit_fh, buffer, length) + call mpi_write_double_1Darray(self % unit_fh, buffer, length, collect_) end if #else write(self % unit_fh) buffer(1:length) @@ -434,7 +434,7 @@ contains if (self % serial) then read(self % unit_fh) buffer(1:length) else - call mpi_read_double_1Darray(self % unit_fh, buffer, length) + call mpi_read_double_1Darray(self % unit_fh, buffer, length, collect_) end if #else read(self % unit_fh) buffer(1:length) @@ -539,7 +539,7 @@ contains #elif MPI if (self % serial) then read(self % unit_fh) buffer(1:length(1),1:length(2)) - then + else call mpi_read_double_2Darray(self % unit_fh, buffer, length, collect_) end if #else @@ -914,7 +914,7 @@ contains if (self % serial) then write(self % unit_fh) buffer(1:length) else - call mpi_write_integer_1Darray(self % unit_fh, buffer, length) + call mpi_write_integer_1Darray(self % unit_fh, buffer, length, collect_) end if #else write(self % unit_fh) buffer(1:length) @@ -968,7 +968,7 @@ contains if (self % serial) then read(self % unit_fh) buffer(1:length) else - call mpi_read_integer_1Darray(self % unit_fh, buffer, length) + call mpi_read_integer_1Darray(self % unit_fh, buffer, length, collect_) end if #else read(self % unit_fh) buffer(1:length) @@ -1557,9 +1557,7 @@ contains class(BinaryOutput) :: self #ifndef HDF5 -# ifndef MPI integer :: j,k ! iteration counters -# endif #endif #ifdef HDF5 @@ -1646,7 +1644,7 @@ contains #elif MPI ! Read tally result - call MPI_FILE_READ(mpi_fh, buffer, n1*n2, MPI_TALLYRESULT, & + call MPI_FILE_READ(self % unit_fh, buffer, n1*n2, MPI_TALLYRESULT, & MPI_STATUS_IGNORE, mpiio_err) #else From 8ce94a1755984585c361bbcd6541535ffe4a3e6d Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 1 Aug 2013 07:17:20 -0400 Subject: [PATCH 10/21] for serial I/O fixed write statements that should be read --- src/output_interface.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 9425e722e1..9b347cce8e 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -1399,7 +1399,7 @@ contains call mpi_read_long(self % unit_fh, buffer, collect_) end if #else - write(self % unit_fh) buffer + read(self % unit_fh) buffer #endif end subroutine read_long @@ -1510,7 +1510,7 @@ contains call mpi_read_string(self % unit_fh, buffer, n, collect_) end if #else - write(self % unit_fh) buffer + read(self % unit_fh) buffer #endif end subroutine read_string From c05cfbc208e7a84b53e53e48c12857af3102734e Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 1 Aug 2013 10:47:29 -0400 Subject: [PATCH 11/21] all data used in c_loc are now targets and buffer for 1D arrays are no longer assumed-size --- src/hdf5_interface.F90 | 50 +++++++++++++++++++++--------------------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index ea21fd0f46..c61880780a 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -7,7 +7,7 @@ module hdf5_interface use, intrinsic :: ISO_C_BINDING #ifdef MPI - use mpi + use mpi, only: MPI_COMM_WORLD, MPI_INFO_NULL #endif implicit none @@ -811,7 +811,7 @@ contains integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - integer, intent(in) :: buffer ! data to write + integer,target, intent(in) :: buffer ! data to write logical, intent(in) :: collect ! collect I/O ! Set rank and dimensions @@ -889,7 +889,7 @@ contains integer, intent(in) :: length ! length of array to write integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - integer, intent(in) :: buffer(:) ! data to write + integer,target, intent(in) :: buffer(length) ! data to write logical, intent(in) :: collect ! collect I/O ! Set rank and dimensions of data @@ -933,7 +933,7 @@ contains integer, intent(in) :: length ! length of array integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - integer, target, intent(inout) :: buffer(:) ! read data to here + integer, target, intent(inout) :: buffer(length) ! read data to here logical, intent(in) :: collect ! collective I/O ! Create property list for independent or collective read @@ -969,7 +969,7 @@ contains integer, intent(in) :: length(2) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - integer, intent(in) :: buffer(length(1),length(2)) ! data to write + integer,target, intent(in) :: buffer(length(1),length(2)) ! data to write logical, intent(in) :: collect ! collective I/O ! Set rank and dimensions @@ -1013,7 +1013,7 @@ contains integer, intent(in) :: length(2) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - integer, intent(inout) :: buffer(length(1),length(2)) ! data to read + integer,target, intent(inout) :: buffer(length(1),length(2)) ! data to read logical, intent(in) :: collect ! collect I/O ! Create property list for independent or collective read @@ -1049,7 +1049,7 @@ contains integer, intent(in) :: length(3) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - integer, intent(in) :: buffer(length(1),length(2), & + integer,target, intent(in) :: buffer(length(1),length(2), & length(3)) ! data to write logical, intent(in) :: collect ! collective I/O @@ -1094,7 +1094,7 @@ contains integer, intent(in) :: length(3) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - integer, intent(inout) :: buffer(length(1),length(2), & + integer,target, intent(inout) :: buffer(length(1),length(2), & length(3)) ! data to read logical, intent(in) :: collect ! collective I/O @@ -1131,7 +1131,7 @@ contains integer, intent(in) :: length(4) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - integer, intent(in) :: buffer(length(1),length(2), & + integer,target, intent(in) :: buffer(length(1),length(2), & length(3),length(4)) ! data to write logical, intent(in) :: collect ! collective I/O @@ -1176,7 +1176,7 @@ contains integer, intent(in) :: length(4) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - integer, intent(inout) :: buffer(length(1),length(2), & + integer,target, intent(inout) :: buffer(length(1),length(2), & length(3),length(4)) ! data to read logical, intent(in) :: collect ! collective I/O @@ -1211,7 +1211,7 @@ contains integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer ! data to write + real(8),target, intent(in) :: buffer ! data to write logical, intent(in) :: collect ! collect I/O ! Set rank and dimensions @@ -1289,7 +1289,7 @@ contains integer, intent(in) :: length ! length of array to write integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer(:) ! data to write + real(8),target, intent(in) :: buffer(length) ! data to write logical, intent(in) :: collect ! collect I/O ! Set rank and dimensions of data @@ -1333,7 +1333,7 @@ contains integer, intent(in) :: length ! length of array integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer(:) ! read data to here + real(8),target, intent(inout) :: buffer(length) ! read data to here logical, intent(in) :: collect ! collective I/O ! Create property list for independent or collective read @@ -1369,7 +1369,7 @@ contains integer, intent(in) :: length(2) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer(length(1),length(2)) ! data to write + real(8),target, intent(in) :: buffer(length(1),length(2)) ! data to write logical, intent(in) :: collect ! collective I/O ! Set rank and dimensions @@ -1393,7 +1393,7 @@ contains call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) ! Write data - f_ptr = c_loc(buffer) + f_ptr = c_loc(buffer(1,1)) call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) ! Close all @@ -1413,7 +1413,7 @@ contains integer, intent(in) :: length(2) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer(length(1),length(2)) ! data to read + real(8),target, intent(inout) :: buffer(length(1),length(2)) ! data to read logical, intent(in) :: collect ! collect I/O ! Create property list for independent or collective read @@ -1449,7 +1449,7 @@ contains integer, intent(in) :: length(3) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer(length(1),length(2), & + real(8),target, intent(in) :: buffer(length(1),length(2), & length(3)) ! data to write logical, intent(in) :: collect ! collective I/O @@ -1494,7 +1494,7 @@ contains integer, intent(in) :: length(3) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer(length(1),length(2), & + real(8),target, intent(inout) :: buffer(length(1),length(2), & length(3)) ! data to read logical, intent(in) :: collect ! collective I/O @@ -1531,7 +1531,7 @@ contains integer, intent(in) :: length(4) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer(length(1),length(2), & + real(8),target, intent(in) :: buffer(length(1),length(2), & length(3),length(4)) ! data to write logical, intent(in) :: collect ! collective I/O @@ -1576,7 +1576,7 @@ contains integer, intent(in) :: length(4) ! length of array dimensions integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer(length(1),length(2), & + real(8),target, intent(inout) :: buffer(length(1),length(2), & length(3),length(4)) ! data to read logical, intent(in) :: collect ! collective I/O @@ -1652,11 +1652,11 @@ contains subroutine hdf5_read_long_parallel(group, name, buffer, long_type, collect) - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer(8), intent(out) :: buffer ! read data to here - integer(HID_T), intent(in) :: long_type ! long integer type - logical, intent(in) :: collect ! collective I/O + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer(8), target, intent(out) :: buffer ! read data to here + integer(HID_T), intent(in) :: long_type ! long integer type + logical, intent(in) :: collect ! collective I/O ! Create property list for independent or collective read call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) From b8e4d4557514003b863da721b3d9662fb55be561 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 14 Aug 2013 09:55:25 -0400 Subject: [PATCH 12/21] when mpi file is opened for writing, APPEND is now used to set file pointers to end of file --- src/mpiio_interface.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mpiio_interface.F90 b/src/mpiio_interface.F90 index 56a1207f35..f34f593942 100644 --- a/src/mpiio_interface.F90 +++ b/src/mpiio_interface.F90 @@ -71,7 +71,7 @@ contains ! Determine access mode open_mode = MPI_MODE_RDONLY if (mode == 'w') then - open_mode = MPI_MODE_WRONLY + open_mode = MPI_MODE_APPEND end if ! Create the file From bce4db9edd174ffb092b652dfe2f9568613b62c2 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 14 Aug 2013 10:27:08 -0400 Subject: [PATCH 13/21] also append to files that use OPEN statement --- src/output_interface.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 9b347cce8e..5d51d17a27 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -180,7 +180,7 @@ contains ! Check for read/write mode to open, default is read only if (mode == 'w') then open(UNIT=self % unit_fh, FILE=filename, ACTION='write', & - STATUS='old', ACCESS='stream') + STATUS='old', ACCESS='stream', POSITION='append') else open(UNIT=self % unit_fh, FILE=filename, ACTION='read', & STATUS='old', ACCESS='stream') @@ -199,7 +199,7 @@ contains ! Check for read/write mode to open, default is read only if (mode == 'w') then open(UNIT=self % unit_fh, FILE=filename, ACTION='write', & - STATUS='old', ACCESS='stream') + STATUS='old', ACCESS='stream', POSITION='append') else open(UNIT=self % unit_fh, FILE=filename, ACTION='read', & STATUS='old', ACCESS='stream') From cb3d56011c45557e6a9edd114a85e882b567d3d3 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 14 Aug 2013 10:43:59 -0400 Subject: [PATCH 14/21] MPI APPEND needs to still have write only in bitwise OR --- src/mpiio_interface.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mpiio_interface.F90 b/src/mpiio_interface.F90 index f34f593942..30093adec9 100644 --- a/src/mpiio_interface.F90 +++ b/src/mpiio_interface.F90 @@ -71,7 +71,7 @@ contains ! Determine access mode open_mode = MPI_MODE_RDONLY if (mode == 'w') then - open_mode = MPI_MODE_APPEND + open_mode = ior(MPI_MODE_APPEND, MPI_MODE_WRONLY) end if ! Create the file From f8cc960dae60e66b399fe584a6e0d11edf51b55e Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 15 Aug 2013 14:37:58 -0400 Subject: [PATCH 15/21] converted code to make serial binary output default, NEWUNIT now used instead of users specifying unit number to output_interface --- src/hdf5_summary.F90 | 2 +- src/initialize.F90 | 2 +- src/output_interface.F90 | 46 ++++++++-------------------------------- src/state_point.F90 | 8 +++---- 4 files changed, 15 insertions(+), 43 deletions(-) diff --git a/src/hdf5_summary.F90 b/src/hdf5_summary.F90 index f6b3e2f6b8..5eff17a4d5 100644 --- a/src/hdf5_summary.F90 +++ b/src/hdf5_summary.F90 @@ -30,7 +30,7 @@ contains character(MAX_FILE_LEN) :: filename = "summary.h5" ! Create a new file using default properties. - call su % file_create(filename, serial=.true.) + call su % file_create(filename) ! Write header information call hdf5_write_header() diff --git a/src/initialize.F90 b/src/initialize.F90 index e6107658f0..de99eca831 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -344,7 +344,7 @@ contains i = i + 1 ! Check what type of file this is - call sp % file_open(argv(i), 'r') + call sp % file_open(argv(i), 'r', serial = .false.) call sp % read_data(filetype, 'filetype') call sp % file_close() diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 5d51d17a27..63bb7743df 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -88,10 +88,9 @@ contains ! FILE_CREATE creates a new file to write data to !=============================================================================== - subroutine file_create(self, filename, serial, unit) + subroutine file_create(self, filename, serial) character(*), intent(in) :: filename ! name of file to be created - integer, optional, intent(in) :: unit ! optional unit number logical, optional, intent(in) :: serial ! processor rank to write from class(BinaryOutput) :: self @@ -99,7 +98,7 @@ contains if (present(serial)) then self % serial = serial else - self % serial = .false. + self % serial = .true. end if #ifdef HDF5 @@ -114,26 +113,13 @@ contains # endif #elif MPI if (self % serial) then - ! Check for specified unit - if (present(unit)) then - self % unit_fh = unit - else - self % unit_fh = 100 - end if - open(UNIT=self % unit_fh, FILE=filename, ACTION="write", & + open(NEWUNIT=self % unit_fh, FILE=filename, ACTION="write", & STATUS='replace', ACCESS='stream') else call mpi_create_file(filename, self % unit_fh) end if #else - ! Check for specified unit - if (present(unit)) then - self % unit_fh = unit - else - self % unit_fh = 100 - end if - - open(UNIT=self % unit_fh, FILE=filename, ACTION="write", & + open(NEWUNIT=self % unit_fh, FILE=filename, ACTION="write", & STATUS='replace', ACCESS='stream') #endif @@ -155,7 +141,7 @@ contains if (present(serial)) then self % serial = serial else - self % serial = .false. + self % serial = .true. end if #ifdef HDF5 @@ -170,38 +156,24 @@ contains # endif #elif MPI if (self % serial) then - ! Check for specified unit - if (present(unit)) then - self % unit_fh = unit - else - self % unit_fh = 100 - end if - ! Check for read/write mode to open, default is read only if (mode == 'w') then - open(UNIT=self % unit_fh, FILE=filename, ACTION='write', & + open(NEWUNIT=self % unit_fh, FILE=filename, ACTION='write', & STATUS='old', ACCESS='stream', POSITION='append') else - open(UNIT=self % unit_fh, FILE=filename, ACTION='read', & + open(NEWUNIT=self % unit_fh, FILE=filename, ACTION='read', & STATUS='old', ACCESS='stream') end if else call mpi_open_file(filename, self % unit_fh, mode) end if #else - ! Check for specified unit - if (present(unit)) then - self % unit_fh = unit - else - self % unit_fh = 100 - end if - ! Check for read/write mode to open, default is read only if (mode == 'w') then - open(UNIT=self % unit_fh, FILE=filename, ACTION='write', & + open(NEWUNIT=self % unit_fh, FILE=filename, ACTION='write', & STATUS='old', ACCESS='stream', POSITION='append') else - open(UNIT=self % unit_fh, FILE=filename, ACTION='read', & + open(NEWUNIT=self % unit_fh, FILE=filename, ACTION='read', & STATUS='old', ACCESS='stream') end if #endif diff --git a/src/state_point.F90 b/src/state_point.F90 index 739d4a36fa..f4ea12ee2b 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -55,7 +55,7 @@ contains if (master) then ! Create statepoint file - call sp % file_create(filename, serial=.true.) + call sp % file_create(filename) ! Write file type call sp % write_data(FILETYPE_STATEPOINT, "filetype") @@ -273,13 +273,13 @@ contains message = "Creating source file " // trim(filename) // "..." call write_message(1) - ! Create statepoint file - call sp % file_create(filename) + ! Create source file + call sp % file_create(filename, serial = .false.) else ! Reopen state point file in parallel - call sp % file_open(filename, 'w') + call sp % file_open(filename, 'w', serial = .false.) end if From a4f08388363a1c0ed06c156f13ca91f67bc66a78 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 16 Aug 2013 09:16:57 -0400 Subject: [PATCH 16/21] updated particle restart modules to use the output interface --- src/DEPENDENCIES | 559 +++++++++++++++++---------------- src/particle_restart.F90 | 177 ++++------- src/particle_restart_write.F90 | 141 +++------ 3 files changed, 377 insertions(+), 500 deletions(-) diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index 1c021fa169..59b68e7c74 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -1,24 +1,32 @@ -ace.o: ace_header.o -ace.o: constants.o -ace.o: endf.o -ace.o: error.o -ace.o: fission.o -ace.o: global.o -ace.o: material_header.o -ace.o: output.o -ace.o: set_header.o -ace.o: string.o +set_header.o: constants.o +set_header.o: list_header.o -ace_header.o: constants.o -ace_header.o: endf_header.o +energy_grid.o: constants.o +energy_grid.o: global.o +energy_grid.o: list_header.o +energy_grid.o: output.o -cmfd_data.o: cmfd_header.o -cmfd_data.o: constants.o -cmfd_data.o: error.o -cmfd_data.o: global.o -cmfd_data.o: mesh.o -cmfd_data.o: mesh_header.o -cmfd_data.o: tally_header.o +list_header.o: constants.o + +cmfd_slepc_solver.o: cmfd_loss_operator.o +cmfd_slepc_solver.o: cmfd_prod_operator.o +cmfd_slepc_solver.o: constants.o +cmfd_slepc_solver.o: global.o + +cmfd_loss_operator.o: constants.o +cmfd_loss_operator.o: global.o + +particle_restart.o: bank_header.o +particle_restart.o: constants.o +particle_restart.o: geometry_header.o +particle_restart.o: global.o +particle_restart.o: output.o +particle_restart.o: output_interface.o +particle_restart.o: particle_header.o +particle_restart.o: random_lcg.o +particle_restart.o: tracking.o + +doppler.o: constants.o cmfd_execute.o: cmfd_data.o cmfd_execute.o: cmfd_message_passing.o @@ -33,108 +41,27 @@ cmfd_execute.o: output.o cmfd_execute.o: search.o cmfd_execute.o: tally.o -cmfd_header.o: constants.o - -cmfd_input.o: cmfd_message_passing.o -cmfd_input.o: error.o -cmfd_input.o: global.o -cmfd_input.o: mesh_header.o -cmfd_input.o: output.o -cmfd_input.o: string.o -cmfd_input.o: tally.o -cmfd_input.o: tally_header.o -cmfd_input.o: tally_initialize.o -cmfd_input.o: templates/cmfd_t.o - -cmfd_jacobian_operator.o: cmfd_loss_operator.o -cmfd_jacobian_operator.o: cmfd_prod_operator.o -cmfd_jacobian_operator.o: constants.o -cmfd_jacobian_operator.o: global.o - -cmfd_loss_operator.o: constants.o -cmfd_loss_operator.o: global.o - -cmfd_message_passing.o: cmfd_header.o -cmfd_message_passing.o: global.o - -cmfd_output.o: cmfd_data.o -cmfd_output.o: cmfd_header.o -cmfd_output.o: constants.o -cmfd_output.o: global.o - cmfd_power_solver.o: cmfd_loss_operator.o cmfd_power_solver.o: cmfd_prod_operator.o cmfd_power_solver.o: constants.o cmfd_power_solver.o: global.o cmfd_power_solver.o: string.o -cmfd_prod_operator.o: constants.o -cmfd_prod_operator.o: global.o +cmfd_message_passing.o: cmfd_header.o +cmfd_message_passing.o: global.o -cmfd_slepc_solver.o: cmfd_loss_operator.o -cmfd_slepc_solver.o: cmfd_prod_operator.o -cmfd_slepc_solver.o: constants.o -cmfd_slepc_solver.o: global.o +random_lcg.o: global.o -cmfd_snes_solver.o: cmfd_jacobian_operator.o -cmfd_snes_solver.o: cmfd_loss_operator.o -cmfd_snes_solver.o: cmfd_power_solver.o -cmfd_snes_solver.o: cmfd_prod_operator.o -cmfd_snes_solver.o: constants.o -cmfd_snes_solver.o: global.o -cmfd_snes_solver.o: string.o - -cross_section.o: ace_header.o -cross_section.o: constants.o -cross_section.o: error.o -cross_section.o: fission.o -cross_section.o: global.o -cross_section.o: material_header.o -cross_section.o: particle_header.o -cross_section.o: random_lcg.o -cross_section.o: search.o - -doppler.o: constants.o - -eigenvalue.o: cmfd_execute.o -eigenvalue.o: constants.o -eigenvalue.o: error.o -eigenvalue.o: global.o -eigenvalue.o: math.o -eigenvalue.o: mesh.o -eigenvalue.o: mesh_header.o -eigenvalue.o: output.o -eigenvalue.o: particle_header.o -eigenvalue.o: random_lcg.o -eigenvalue.o: search.o -eigenvalue.o: source.o -eigenvalue.o: state_point.o -eigenvalue.o: string.o -eigenvalue.o: tally.o -eigenvalue.o: tracking.o - -endf.o: constants.o -endf.o: string.o - -energy_grid.o: constants.o -energy_grid.o: global.o -energy_grid.o: list_header.o -energy_grid.o: output.o - -error.o: global.o - -finalize.o: cmfd_output.o -finalize.o: global.o -finalize.o: hdf5_interface.o -finalize.o: output.o -finalize.o: tally.o - -fission.o: ace_header.o -fission.o: constants.o -fission.o: error.o -fission.o: global.o -fission.o: interpolation.o -fission.o: search.o +plot.o: constants.o +plot.o: error.o +plot.o: geometry.o +plot.o: geometry_header.o +plot.o: global.o +plot.o: output.o +plot.o: particle_header.o +plot.o: plot_header.o +plot.o: ppmlib.o +plot.o: string.o fixed_source.o: constants.o fixed_source.o: global.o @@ -147,64 +74,53 @@ fixed_source.o: string.o fixed_source.o: tally.o fixed_source.o: tracking.o -geometry.o: constants.o -geometry.o: error.o -geometry.o: geometry_header.o -geometry.o: global.o -geometry.o: output.o -geometry.o: particle_header.o -geometry.o: particle_restart_write.o -geometry.o: string.o -geometry.o: tally.o +source.o: bank_header.o +source.o: constants.o +source.o: error.o +source.o: geometry_header.o +source.o: global.o +source.o: math.o +source.o: output.o +source.o: particle_header.o +source.o: random_lcg.o +source.o: string.o -global.o: ace_header.o -global.o: bank_header.o -global.o: cmfd_header.o -global.o: constants.o -global.o: dict_header.o -global.o: geometry_header.o -global.o: hdf5_interface.o -global.o: material_header.o -global.o: mesh_header.o -global.o: particle_header.o -global.o: plot_header.o -global.o: set_header.o -global.o: source_header.o -global.o: tally_header.o -global.o: timer_header.o +cmfd_prod_operator.o: constants.o +cmfd_prod_operator.o: global.o -hdf5_summary.o: ace_header.o -hdf5_summary.o: constants.o -hdf5_summary.o: endf.o -hdf5_summary.o: geometry_header.o -hdf5_summary.o: global.o -hdf5_summary.o: material_header.o -hdf5_summary.o: mesh_header.o -hdf5_summary.o: output_interface.o -hdf5_summary.o: output.o -hdf5_summary.o: string.o -hdf5_summary.o: tally_header.o +ace_header.o: constants.o +ace_header.o: endf_header.o -initialize.o: ace.o -initialize.o: bank_header.o -initialize.o: constants.o -initialize.o: dict_header.o -initialize.o: energy_grid.o -initialize.o: error.o -initialize.o: geometry.o -initialize.o: geometry_header.o -initialize.o: global.o -initialize.o: hdf5_interface.o -initialize.o: hdf5_summary.o -initialize.o: input_xml.o -initialize.o: output_interface.o -initialize.o: output.o -initialize.o: random_lcg.o -initialize.o: source.o -initialize.o: state_point.o -initialize.o: string.o -initialize.o: tally_header.o -initialize.o: tally_initialize.o +fission.o: ace_header.o +fission.o: constants.o +fission.o: error.o +fission.o: global.o +fission.o: interpolation.o +fission.o: search.o + +cmfd_jacobian_operator.o: cmfd_loss_operator.o +cmfd_jacobian_operator.o: cmfd_prod_operator.o +cmfd_jacobian_operator.o: constants.o +cmfd_jacobian_operator.o: global.o + +cmfd_snes_solver.o: cmfd_jacobian_operator.o +cmfd_snes_solver.o: cmfd_loss_operator.o +cmfd_snes_solver.o: cmfd_power_solver.o +cmfd_snes_solver.o: cmfd_prod_operator.o +cmfd_snes_solver.o: constants.o +cmfd_snes_solver.o: global.o +cmfd_snes_solver.o: string.o + +cmfd_input.o: cmfd_message_passing.o +cmfd_input.o: error.o +cmfd_input.o: global.o +cmfd_input.o: mesh_header.o +cmfd_input.o: output.o +cmfd_input.o: string.o +cmfd_input.o: tally.o +cmfd_input.o: tally_header.o +cmfd_input.o: tally_initialize.o +cmfd_input.o: templates/cmfd_t.o input_xml.o: cmfd_input.o input_xml.o: constants.o @@ -227,15 +143,6 @@ input_xml.o: templates/plots_t.o input_xml.o: templates/settings_t.o input_xml.o: templates/tallies_t.o -interpolation.o: constants.o -interpolation.o: endf_header.o -interpolation.o: error.o -interpolation.o: global.o -interpolation.o: search.o -interpolation.o: string.o - -list_header.o: constants.o - main.o: constants.o main.o: eigenvalue.o main.o: finalize.o @@ -245,15 +152,211 @@ main.o: initialize.o main.o: particle_restart.o main.o: plot.o +particle_restart_write.o: bank_header.o +particle_restart_write.o: global.o +particle_restart_write.o: output_interface.o +particle_restart_write.o: particle_header.o +particle_restart_write.o: string.o + +timer_header.o: constants.o + math.o: constants.o math.o: random_lcg.o +interpolation.o: constants.o +interpolation.o: endf_header.o +interpolation.o: error.o +interpolation.o: global.o +interpolation.o: search.o +interpolation.o: string.o + +cmfd_data.o: cmfd_header.o +cmfd_data.o: constants.o +cmfd_data.o: error.o +cmfd_data.o: global.o +cmfd_data.o: mesh.o +cmfd_data.o: mesh_header.o +cmfd_data.o: tally_header.o + +cmfd_output.o: cmfd_data.o +cmfd_output.o: cmfd_header.o +cmfd_output.o: constants.o +cmfd_output.o: global.o + +global.o: ace_header.o +global.o: bank_header.o +global.o: cmfd_header.o +global.o: constants.o +global.o: dict_header.o +global.o: geometry_header.o +global.o: hdf5_interface.o +global.o: material_header.o +global.o: mesh_header.o +global.o: plot_header.o +global.o: set_header.o +global.o: source_header.o +global.o: tally_header.o +global.o: timer_header.o + +string.o: constants.o +string.o: error.o +string.o: global.o + +finalize.o: cmfd_output.o +finalize.o: global.o +finalize.o: hdf5_interface.o +finalize.o: output.o +finalize.o: tally.o + +tally_initialize.o: constants.o +tally_initialize.o: global.o +tally_initialize.o: tally_header.o + +tally.o: ace_header.o +tally.o: constants.o +tally.o: error.o +tally.o: global.o +tally.o: math.o +tally.o: mesh.o +tally.o: mesh_header.o +tally.o: output.o +tally.o: particle_header.o +tally.o: search.o +tally.o: string.o +tally.o: tally_header.o + +particle_header.o: constants.o +particle_header.o: geometry_header.o + +output_interface.o: constants.o +output_interface.o: error.o +output_interface.o: global.o +output_interface.o: hdf5_interface.o +output_interface.o: mpiio_interface.o +output_interface.o: tally_header.o + mesh.o: constants.o mesh.o: global.o mesh.o: mesh_header.o mesh.o: particle_header.o mesh.o: search.o +endf.o: constants.o +endf.o: string.o + +initialize.o: ace.o +initialize.o: bank_header.o +initialize.o: constants.o +initialize.o: dict_header.o +initialize.o: energy_grid.o +initialize.o: error.o +initialize.o: geometry.o +initialize.o: geometry_header.o +initialize.o: global.o +initialize.o: hdf5_interface.o +initialize.o: hdf5_summary.o +initialize.o: input_xml.o +initialize.o: output.o +initialize.o: output_interface.o +initialize.o: random_lcg.o +initialize.o: source.o +initialize.o: state_point.o +initialize.o: string.o +initialize.o: tally_header.o +initialize.o: tally_initialize.o + +cross_section.o: ace_header.o +cross_section.o: constants.o +cross_section.o: error.o +cross_section.o: fission.o +cross_section.o: global.o +cross_section.o: material_header.o +cross_section.o: particle_header.o +cross_section.o: random_lcg.o +cross_section.o: search.o + +state_point.o: constants.o +state_point.o: error.o +state_point.o: global.o +state_point.o: output.o +state_point.o: output_interface.o +state_point.o: string.o +state_point.o: tally_header.o + +eigenvalue.o: cmfd_execute.o +eigenvalue.o: constants.o +eigenvalue.o: error.o +eigenvalue.o: global.o +eigenvalue.o: math.o +eigenvalue.o: mesh.o +eigenvalue.o: mesh_header.o +eigenvalue.o: output.o +eigenvalue.o: particle_header.o +eigenvalue.o: random_lcg.o +eigenvalue.o: search.o +eigenvalue.o: source.o +eigenvalue.o: state_point.o +eigenvalue.o: string.o +eigenvalue.o: tally.o +eigenvalue.o: tracking.o + +search.o: error.o +search.o: global.o + +tracking.o: cross_section.o +tracking.o: error.o +tracking.o: geometry.o +tracking.o: geometry_header.o +tracking.o: global.o +tracking.o: output.o +tracking.o: particle_header.o +tracking.o: physics.o +tracking.o: random_lcg.o +tracking.o: string.o +tracking.o: tally.o + +ace.o: ace_header.o +ace.o: constants.o +ace.o: endf.o +ace.o: error.o +ace.o: fission.o +ace.o: global.o +ace.o: material_header.o +ace.o: output.o +ace.o: set_header.o +ace.o: string.o + +geometry.o: constants.o +geometry.o: error.o +geometry.o: geometry_header.o +geometry.o: global.o +geometry.o: output.o +geometry.o: particle_header.o +geometry.o: particle_restart_write.o +geometry.o: string.o +geometry.o: tally.o + +plot_header.o: constants.o + +cmfd_header.o: constants.o + +tally_header.o: constants.o + +hdf5_summary.o: ace_header.o +hdf5_summary.o: constants.o +hdf5_summary.o: endf.o +hdf5_summary.o: geometry_header.o +hdf5_summary.o: global.o +hdf5_summary.o: hdf5_interface.o +hdf5_summary.o: material_header.o +hdf5_summary.o: mesh_header.o +hdf5_summary.o: output.o +hdf5_summary.o: output_interface.o +hdf5_summary.o: string.o +hdf5_summary.o: tally_header.o + +error.o: global.o + output.o: ace_header.o output.o: constants.o output.o: endf.o @@ -268,35 +371,8 @@ output.o: plot_header.o output.o: string.o output.o: tally_header.o -output_interface.o: constants.o -output_interface.o: error.o -output_interface.o: global.o -output_interface.o: hdf5_interface.o -output_interface.o: mpiio_interface.o -output_interface.o: tally_header.o - -particle_header.o: constants.o -particle_header.o: geometry_header.o - -particle_restart.o: bank_header.o -particle_restart.o: constants.o -particle_restart.o: geometry_header.o -particle_restart.o: global.o -particle_restart.o: hdf5_interface.o -particle_restart.o: output.o -particle_restart.o: particle_header.o -particle_restart.o: random_lcg.o -particle_restart.o: tracking.o - -particle_restart_write.o: bank_header.o -particle_restart_write.o: global.o -particle_restart_write.o: hdf5_interface.o -particle_restart_write.o: particle_header.o -particle_restart_write.o: string.o - physics.o: ace_header.o physics.o: constants.o -physics.o: cross_section.o physics.o: endf.o physics.o: error.o physics.o: fission.o @@ -312,78 +388,3 @@ physics.o: random_lcg.o physics.o: search.o physics.o: string.o -plot.o: constants.o -plot.o: error.o -plot.o: geometry.o -plot.o: geometry_header.o -plot.o: global.o -plot.o: output.o -plot.o: particle_header.o -plot.o: plot_header.o -plot.o: ppmlib.o -plot.o: string.o - -plot_header.o: constants.o - -random_lcg.o: global.o - -search.o: error.o -search.o: global.o - -set_header.o: constants.o -set_header.o: list_header.o - -source.o: bank_header.o -source.o: constants.o -source.o: error.o -source.o: geometry_header.o -source.o: global.o -source.o: math.o -source.o: output.o -source.o: particle_header.o -source.o: random_lcg.o -source.o: string.o - -state_point.o: constants.o -state_point.o: error.o -state_point.o: global.o -state_point.o: output.o -state_point.o: output_interface.o -state_point.o: string.o -state_point.o: tally_header.o - -string.o: constants.o -string.o: error.o -string.o: global.o - -tally.o: ace_header.o -tally.o: constants.o -tally.o: error.o -tally.o: global.o -tally.o: math.o -tally.o: mesh.o -tally.o: mesh_header.o -tally.o: output.o -tally.o: particle_header.o -tally.o: search.o -tally.o: string.o -tally.o: tally_header.o - -tally_header.o: constants.o - -tally_initialize.o: constants.o -tally_initialize.o: global.o -tally_initialize.o: tally_header.o - -timer_header.o: constants.o - -tracking.o: cross_section.o -tracking.o: error.o -tracking.o: geometry.o -tracking.o: geometry_header.o -tracking.o: global.o -tracking.o: output.o -tracking.o: particle_header.o -tracking.o: physics.o -tracking.o: string.o -tracking.o: tally.o diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index d34f195753..c524170a69 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -2,123 +2,27 @@ module particle_restart use, intrinsic :: ISO_FORTRAN_ENV - use bank_header, only: Bank + use bank_header, only: Bank use constants - use geometry_header, only: BASE_UNIVERSE + use geometry_header, only: BASE_UNIVERSE use global - use output, only: write_message, print_particle - use particle_header, only: Particle - use random_lcg, only: set_particle_seed - use tracking, only: transport - -#ifdef HDF5 - use hdf5_interface -#endif + use output, only: write_message, print_particle + use output_interface, only: BinaryOutput + use particle_header, only: Particle + use random_lcg, only: set_particle_seed + use tracking, only: transport implicit none private public :: run_particle_restart -#ifdef HDF5 - integer(HID_T) :: hdf5_particle_file -#endif - - ! Short names for output and error units - integer :: ou = OUTPUT_UNIT - integer :: eu = ERROR_UNIT + ! Binary file + type(BinaryOutput) :: pr contains -#ifdef HDF5 - !=============================================================================== -! READ_HDF5_PARTICLE_RESTART -!=============================================================================== - - subroutine read_hdf5_particle_restart(p) - - type(Particle), intent(inout) :: p - - ! write meessage - message = "Loading particle restart file " // trim(path_particle_restart) & - // "..." - call write_message(1) - - ! open hdf5 file - call h5fopen_f(path_particle_restart, H5F_ACC_RDONLY_F, hdf5_particle_file,& - hdf5_err) - - ! read data from file - call hdf5_read_integer(hdf5_particle_file, 'current_batch', current_batch) - call hdf5_read_integer(hdf5_particle_file, 'gen_per_batch', gen_per_batch) - call hdf5_read_integer(hdf5_particle_file, 'current_gen', current_gen) - call hdf5_read_long(hdf5_particle_file, 'n_particles', n_particles, hdf5_integer8_t) - call hdf5_read_long(hdf5_particle_file, 'id', p % id, hdf5_integer8_t) - call hdf5_read_double(hdf5_particle_file, 'weight', p % wgt) - call hdf5_read_double(hdf5_particle_file, 'energy', p % E) - dims1 = (/3/) - call h5ltread_dataset_double_f(hdf5_particle_file, 'xyz', p % coord % xyz, & - dims1, hdf5_err) - call h5ltread_dataset_double_f(hdf5_particle_file, 'uvw', p % coord % uvw, & - dims1, hdf5_err) - - ! set particle last attributes - p % last_wgt = p % wgt - p % last_xyz = p % coord % xyz - p % last_E = p % E - - ! close hdf5 file - call h5fclose_f(hdf5_particle_file, hdf5_err) - - end subroutine read_hdf5_particle_restart - -#endif - -!=============================================================================== -! READ_BINARY_PARTICLE_RESTART -!=============================================================================== - - subroutine read_binary_particle_restart(p) - - type(Particle), intent(inout) :: p - - integer :: filetype - integer :: revision - - ! write meessage - message = "Loading particle restart file " // trim(path_particle_restart) & - // "..." - call write_message(1) - - ! open file - open(UNIT=UNIT_PARTICLE, FILE=path_particle_restart, STATUS='old', & - ACCESS='stream') - - ! read data from file - read(UNIT_PARTICLE) filetype - read(UNIT_PARTICLE) revision - read(UNIT_PARTICLE) current_batch - read(UNIT_PARTICLE) gen_per_batch - read(UNIT_PARTICLE) current_gen - read(UNIT_PARTICLE) n_particles - read(UNIT_PARTICLE) p % id - read(UNIT_PARTICLE) p % wgt - read(UNIT_PARTICLE) p % E - read(UNIT_PARTICLE) p % coord % xyz - read(UNIT_PARTICLE) p % coord % uvw - - ! set particle last attributes - p % last_wgt = p % wgt - p % last_xyz = p % coord % xyz - p % last_E = p % E - - ! close hdf5 file - close(UNIT_PARTICLE) - - end subroutine read_binary_particle_restart - -!=============================================================================== -! RUN_PARTICLE_RESTART +! RUN_PARTICLE_RESTART is the main routine that runs the particle restart !=============================================================================== subroutine run_particle_restart() @@ -126,30 +30,69 @@ contains integer(8) :: particle_seed type(Particle) :: p - ! initialize the particle to be tracked + ! Set verbosity high + verbosity = 10 + + ! Initialize the particle to be tracked call p % initialize() - ! read in the restart information -#ifdef HDF5 - call read_hdf5_particle_restart(p) -#else - call read_binary_particle_restart(p) -#endif + ! Read in the restart information + call read_particle_restart(p) - ! set all tallies to 0 for now (just tracking errors) + ! Set all tallies to 0 for now (just tracking errors) n_tallies = 0 - ! compute random number seed + ! Compute random number seed particle_seed = ((current_batch - 1)*gen_per_batch + & current_gen - 1)*n_particles + p % id call set_particle_seed(particle_seed) - ! transport neutron + ! Transport neutron call transport(p) - ! write output if particle made it + ! Write output if particle made it call print_particle(p) end subroutine run_particle_restart +!=============================================================================== +! READ_PARTICLE_RESTART reads the particle restart file +!=============================================================================== + + subroutine read_particle_restart(p) + + integer :: int_scalar + type(Particle), intent(inout) :: p + + ! Write meessage + message = "Loading particle restart file " // trim(path_particle_restart) & + // "..." + call write_message(1) + + ! Open file + call pr % file_open(path_particle_restart, 'r') + + ! Read data from file + call pr % read_data(int_scalar, 'filetype') + call pr % read_data(int_scalar, 'revision') + call pr % read_data(current_batch, 'current_batch') + call pr % read_data(gen_per_batch, 'gen_per_batch') + call pr % read_data(current_gen, 'current_gen') + call pr % read_data(n_particles, 'n_particles') + call pr % read_data(p % id, 'id') + call pr % read_data(p % wgt, 'weight') + call pr % read_data(p % E, 'energy') + call pr % read_data(p % coord % xyz, 'xyz', length=3) + call pr % read_data(p % coord % uvw, 'uvw', length=3) + + ! Set particle last attributes + p % last_wgt = p % wgt + p % last_xyz = p % coord % xyz + p % last_E = p % E + + ! Close hdf5 file + call pr % file_close() + + end subroutine read_particle_restart + end module particle_restart diff --git a/src/particle_restart_write.F90 b/src/particle_restart_write.F90 index 0820224e11..6742de2729 100644 --- a/src/particle_restart_write.F90 +++ b/src/particle_restart_write.F90 @@ -1,132 +1,65 @@ module particle_restart_write - use, intrinsic :: ISO_FORTRAN_ENV - - use bank_header, only: Bank + use bank_header, only: Bank use global - use particle_header, only: Particle - use string, only: to_str - -#ifdef HDF5 - use hdf5_interface -#endif + use output_interface, only: BinaryOutput + use particle_header, only: Particle + use string, only: to_str implicit none private public :: write_particle_restart -#ifdef HDF5 - integer(HID_T) :: hdf5_particle_file -#endif + ! Binary output file + type(BinaryOutput) :: pr contains !=============================================================================== -! WRITE_PARTICLE_RESTART +! WRITE_PARTICLE_RESTART is the main routine that writes out the particle file !=============================================================================== subroutine write_particle_restart(p) type(Particle), intent(in) :: p + character(MAX_FILE_LEN) :: filename + type(Bank), pointer :: src => null() + ! Dont write another restart file if in particle restart mode if (run_mode == MODE_PARTICLE) return - ! write out binary or HDF5 file + ! Set up file name + filename = trim(path_output) // 'particle_' // trim(to_str(current_batch)) & + // '_' // trim(to_str(current_work)) #ifdef HDF5 - call write_particle_restart_hdf5(p) + filename = trim(filename) // '.h5' #else - call write_particle_restart_binary(p) + filename = trim(filename) // '.binary' #endif + ! Create file + call pr % file_create(filename) + + ! Get information about source particle + src => source_bank(current_work) + + ! Write data to file + call pr % write_data(FILETYPE_PARTICLE_RESTART, 'filetype') + call pr % write_data(REVISION_PARTICLE_RESTART, 'revision') + call pr % write_data(current_batch, 'current_batch') + call pr % write_data(gen_per_batch, 'gen_per_batch') + call pr % write_data(current_gen, 'current_gen') + call pr % write_data(n_particles, 'n_particles') + call pr % write_data(p % id, 'id') + call pr % write_data(src % wgt, 'weight') + call pr % write_data(src % E, 'energy') + call pr % write_data(src % xyz, 'xyz', length = 3) + call pr % write_data(src % uvw, 'uvw', length = 3) + + ! Close file + call pr % file_close() + end subroutine write_particle_restart -#ifdef HDF5 - -!=============================================================================== -! WRITE_PARTICLE_RESTART_HDF5 -!=============================================================================== - - subroutine write_particle_restart_hdf5(p) - - type(Particle), intent(in) :: p - - character(MAX_FILE_LEN) :: filename - type(Bank), pointer :: src => null() - - ! set up file name - filename = trim(path_output) // 'particle_' // trim(to_str(current_batch)) & - // '_' // trim(to_str(current_work)) // '.h5' - - ! create hdf5 file - call h5fcreate_f(filename, H5F_ACC_TRUNC_F, hdf5_particle_file, hdf5_err) - - ! get information about source particle - src => source_bank(current_work) - - ! write data to file - call hdf5_write_integer(hdf5_particle_file, 'filetype', & - FILETYPE_PARTICLE_RESTART) - call hdf5_write_integer(hdf5_particle_file, 'revision', & - REVISION_PARTICLE_RESTART) - call hdf5_write_integer(hdf5_particle_file, 'current_batch', current_batch) - call hdf5_write_integer(hdf5_particle_file, 'gen_per_batch', gen_per_batch) - call hdf5_write_integer(hdf5_particle_file, 'current_gen', current_gen) - call hdf5_write_long(hdf5_particle_file, 'n_particles', n_particles, hdf5_integer8_t) - call hdf5_write_long(hdf5_particle_file, 'id', p % id, hdf5_integer8_t) - call hdf5_write_double(hdf5_particle_file, 'weight', src % wgt) - call hdf5_write_double(hdf5_particle_file, 'energy', src % E) - dims1 = (/3/) - call h5ltmake_dataset_double_f(hdf5_particle_file, 'xyz', 1, dims1, & - src % xyz, hdf5_err) - call h5ltmake_dataset_double_f(hdf5_particle_file, 'uvw', 1, dims1, & - src % uvw, hdf5_err) - - ! close hdf5 file - call h5fclose_f(hdf5_particle_file, hdf5_err) - - end subroutine write_particle_restart_hdf5 - -#endif - -!=============================================================================== -! WRITE_PARTICLE_RESTART_BINARY -!=============================================================================== - - subroutine write_particle_restart_binary(p) - - type(Particle), intent(in) :: p - - character(MAX_FILE_LEN) :: filename - type(Bank), pointer :: src => null() - - ! set up file name - filename = trim(path_output) // 'particle_' // trim(to_str(current_batch)) & - // '_' // trim(to_str(current_work)) // '.binary' - - ! create hdf5 file - open(UNIT=UNIT_PARTICLE, FILE=filename, STATUS='replace', & - ACCESS='stream') - - ! get information about source particle - src => source_bank(current_work) - - ! write data to file - write(UNIT_PARTICLE) FILETYPE_PARTICLE_RESTART - write(UNIT_PARTICLE) REVISION_PARTICLE_RESTART - write(UNIT_PARTICLE) current_batch - write(UNIT_PARTICLE) gen_per_batch - write(UNIT_PARTICLE) current_gen - write(UNIT_PARTICLE) n_particles - write(UNIT_PARTICLE) p % id - write(UNIT_PARTICLE) src % wgt - write(UNIT_PARTICLE) src % E - write(UNIT_PARTICLE) src % xyz - write(UNIT_PARTICLE) src % uvw - - ! close hdf5 file - close(UNIT_PARTICLE) - - end subroutine write_particle_restart_binary - end module particle_restart_write From 038a83a24ea56aa43e942ac4d866d5565ec3accd Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 16 Aug 2013 10:40:43 -0400 Subject: [PATCH 17/21] output interface is now private and updated hdf5 summary to call hdf5 groups through output interface --- src/hdf5_summary.F90 | 22 +++++------ src/output_interface.F90 | 80 ++++++++++++++++++++++++++++------------ 2 files changed, 66 insertions(+), 36 deletions(-) diff --git a/src/hdf5_summary.F90 b/src/hdf5_summary.F90 index 5eff17a4d5..915e6af070 100644 --- a/src/hdf5_summary.F90 +++ b/src/hdf5_summary.F90 @@ -7,7 +7,6 @@ module hdf5_summary use endf, only: reaction_name use geometry_header, only: Cell, Surface, Universe, Lattice use global - use hdf5_interface, only: hdf5_open_group, hdf5_close_group use material_header, only: Material use mesh_header, only: StructuredMesh use output_interface @@ -117,8 +116,8 @@ contains ! WRITE INFORMATION ON CELLS ! Create a cell group (nothing directly written in this group) then close - call hdf5_open_group(su % hdf5_fh, "geometry/cells", su % hdf5_grp) - call hdf5_close_group(su % hdf5_grp) + call su % open_group("geometry/cells") + call su % close_group() ! Write information on each cell CELL_LOOP: do i = 1, n_cells @@ -164,8 +163,8 @@ contains ! WRITE INFORMATION ON SURFACES ! Create surfaces group (nothing directly written here) then close - call hdf5_open_group(su % hdf5_fh, "geometry/surfaces", su % hdf5_grp) - call hdf5_close_group(su % hdf5_grp) + call su % open_group("geometry/surfaces") + call su % close_group() ! Write information on each surface SURFACE_LOOP: do i = 1, n_surfaces @@ -248,8 +247,8 @@ contains ! WRITE INFORMATION ON UNIVERSES ! Create universes group (nothing directly written here) then close - call hdf5_open_group(su % hdf5_fh, "geometry/universes", su % hdf5_grp) - call hdf5_close_group(su % hdf5_grp) + call su % open_group("geometry/universes") + call su % close_group() ! Write information on each universe UNIVERSE_LOOP: do i = 1, n_universes @@ -267,8 +266,8 @@ contains ! WRITE INFORMATION ON LATTICES ! Create lattices group (nothing directly written here) then close - call hdf5_open_group(su % hdf5_fh, "geometry/lattices", su % hdf5_grp) - call hdf5_close_group(su % hdf5_grp) + call su % open_group("geometry/lattices") + call su % close_group() ! Write information on each lattice LATTICE_LOOP: do i = 1, n_lattices @@ -574,9 +573,8 @@ contains ! WRITE INFORMATION ON EACH REACTION ! Create overall group for reactions and close it - call hdf5_open_group(su % hdf5_fh, "nuclides/" // trim(nuc % name) // & - "/reactions", su % hdf5_grp) - call hdf5_close_group(su % hdf5_grp) + call su % open_group("nuclides/" // trim(nuc % name) // "/reactions") + call su % close_group() RXN_LOOP: do j = 1, nuc % n_reaction ! Information on each reaction diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 63bb7743df..70681f2ffb 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -15,6 +15,7 @@ module output_interface private type, public :: BinaryOutput + private ! Compilation specific data #ifdef HDF5 integer(HID_T) :: hdf5_fh @@ -48,38 +49,40 @@ module output_interface read_integer_4Darray, & read_long, & read_string + procedure :: write_double => write_double + procedure :: write_double_1Darray => write_double_1Darray + procedure :: write_double_2Darray => write_double_2Darray + procedure :: write_double_3Darray => write_double_3Darray + procedure :: write_double_4Darray => write_double_4Darray + procedure :: write_integer => write_integer + procedure :: write_integer_1Darray => write_integer_1Darray + procedure :: write_integer_2Darray => write_integer_2Darray + procedure :: write_integer_3Darray => write_integer_3Darray + procedure :: write_integer_4Darray => write_integer_4Darray + procedure :: write_long => write_long + procedure :: write_string => write_string + procedure :: read_double => read_double + procedure :: read_double_1Darray => read_double_1Darray + procedure :: read_double_2Darray => read_double_2Darray + procedure :: read_double_3Darray => read_double_3Darray + procedure :: read_double_4Darray => read_double_4Darray + procedure :: read_integer => read_integer + procedure :: read_integer_1Darray => read_integer_1Darray + procedure :: read_integer_2Darray => read_integer_2Darray + procedure :: read_integer_3Darray => read_integer_3Darray + procedure :: read_integer_4Darray => read_integer_4Darray + procedure :: read_long => read_long + procedure :: read_string => read_string procedure, public :: file_create => file_create procedure, public :: file_open => file_open procedure, public :: file_close => file_close - procedure, public :: write_double => write_double - procedure, public :: write_double_1Darray => write_double_1Darray - procedure, public :: write_double_2Darray => write_double_2Darray - procedure, public :: write_double_3Darray => write_double_3Darray - procedure, public :: write_double_4Darray => write_double_4Darray - procedure, public :: write_integer => write_integer - procedure, public :: write_integer_1Darray => write_integer_1Darray - procedure, public :: write_integer_2Darray => write_integer_2Darray - procedure, public :: write_integer_3Darray => write_integer_3Darray - procedure, public :: write_integer_4Darray => write_integer_4Darray - procedure, public :: write_long => write_long - procedure, public :: write_string => write_string - procedure, public :: read_double => read_double - procedure, public :: read_double_1Darray => read_double_1Darray - procedure, public :: read_double_2Darray => read_double_2Darray - procedure, public :: read_double_3Darray => read_double_3Darray - procedure, public :: read_double_4Darray => read_double_4Darray - procedure, public :: read_integer => read_integer - procedure, public :: read_integer_1Darray => read_integer_1Darray - procedure, public :: read_integer_2Darray => read_integer_2Darray - procedure, public :: read_integer_3Darray => read_integer_3Darray - procedure, public :: read_integer_4Darray => read_integer_4Darray - procedure, public :: read_long => read_long - procedure, public :: read_string => read_string procedure, public :: write_attribute_string => write_attribute_string procedure, public :: write_tally_result => write_tally_result procedure, public :: read_tally_result => read_tally_result procedure, public :: write_source_bank => write_source_bank procedure, public :: read_source_bank => read_source_bank + procedure, public :: open_group => open_group + procedure, public :: close_group => close_group end type BinaryOutput contains @@ -206,6 +209,35 @@ contains end subroutine file_close +!=============================================================================== +! OPEN_GROUP call hdf5 routine to open a group within binary output context +!=============================================================================== + + subroutine open_group(self, group) + + character(*), intent(in) :: group ! HDF5 group name + class(BinaryOutput) :: self + +#ifdef HDF5 + call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) +#endif + + end subroutine open_group + +!=============================================================================== +! CLOSE_GROUP call hdf5 routine to close a group within binary output context +!=============================================================================== + + subroutine close_group(self) + + class(BinaryOutput) :: self + +#ifdef HDF5 + call hdf5_close_group(self % hdf5_grp) +#endif + + end subroutine close_group + !=============================================================================== ! WRITE_DOUBLE writes double precision scalar data !=============================================================================== From b8ed9868ea10e45d3c22d8ea3ac65e187e123b55 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 4 Sep 2013 11:40:13 -0400 Subject: [PATCH 18/21] Statepoint file is now closed and reopened in parallel --- src/state_point.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index f4ea12ee2b..d5f1af732c 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -657,6 +657,7 @@ contains end do TALLY_RESULTS end if + call sp % file_close() end if ! Read source if in eigenvalue mode @@ -681,11 +682,13 @@ contains message = "Loading source file " // trim(filename) // "..." call write_message(1) - ! Open source file - call sp % file_open(filename, 'r') - + else + filename = path_state_point end if + ! Open file that contains source + call sp % file_open(filename, 'r', serial = .false.) + ! Write out source call sp % read_source_bank() From 546f47e36e1672a7b950491f480b82f2d95854a8 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 4 Sep 2013 11:41:26 -0400 Subject: [PATCH 19/21] changed way offset is calculated for MPI source bank reading, now referenced off of EOF --- src/output_interface.F90 | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 2d44cd2b73..96c04549e7 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -1848,20 +1848,21 @@ contains #elif MPI - ! Get current offset for master - if (master) call MPI_FILE_GET_POSITION(self % unit_fh, offset, mpiio_err) + ! Go to the end of the file to set file pointer + offset = 0 + call MPI_FILE_SEEK(self % unit_fh, offset, MPI_SEEK_END, & + mpiio_err) - ! Determine offset on master process and broadcast to all processors - call MPI_SIZEOF(offset, size_offset_kind, mpi_err) - select case (size_offset_kind) - case (4) - call MPI_BCAST(offset, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, mpi_err) - case (8) - call MPI_BCAST(offset, 1, MPI_INTEGER8, 0, MPI_COMM_WORLD, mpi_err) - end select + ! Get current offset (will be at EOF) + call MPI_FILE_GET_POSITION(self % unit_fh, offset, mpiio_err) + + ! Get the size of the source bank on all procs + call MPI_TYPE_SIZE(MPI_BANK, size_bank, mpi_err) + + ! Calculate offset where the source bank will begin + offset = offset - n_particles*size_bank ! Set the proper offset for source data on this processor - call MPI_TYPE_SIZE(MPI_BANK, size_bank, mpi_err) offset = offset + size_bank*maxwork*rank ! Write all source sites From cfdad90af76aa8f64ccf00dd9f11cc7dd0138e99 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 4 Sep 2013 13:58:09 -0400 Subject: [PATCH 20/21] only close and reopen file for MPI reading of source bank --- src/state_point.F90 | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index d5f1af732c..dfa88674cc 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -657,7 +657,13 @@ contains end do TALLY_RESULTS end if + +#ifdef MPI + ! If using MPI, file needs to be closed and reopened in parallel + ! If serial, we cannot close the file or we will lose our file position call sp % file_close() +# endif + end if ! Read source if in eigenvalue mode @@ -682,12 +688,18 @@ contains message = "Loading source file " // trim(filename) // "..." call write_message(1) - else - filename = path_state_point - end if + ! Open source file + call sp % file_open(filename, 'r', serial = .false.) - ! Open file that contains source - call sp % file_open(filename, 'r', serial = .false.) + else + +#ifdef MPI + ! Reopen statepoint file in parallel, but only if MPI + ! We will compute the position where the source begins + call sp % file_open(path_state_point, 'r', serial = .false.) +#endif + + end if ! Write out source call sp % read_source_bank() From 69373e6ee5e3cb35cdaada20aecb8a23fc0149c5 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 7 Sep 2013 10:28:39 -0400 Subject: [PATCH 21/21] Fix two typos. --- src/output_interface.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 0cdb87bc0f..8137fb63d8 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -341,7 +341,7 @@ contains end subroutine read_double !=============================================================================== -! WRITE_DOUBLE_1DARRAY writes double presicions 1-D array data +! WRITE_DOUBLE_1DARRAY writes double precision 1-D array data !=============================================================================== subroutine write_double_1Darray(self, buffer, name, group, length, collect) @@ -874,7 +874,7 @@ contains end subroutine read_integer !=============================================================================== -! WRITE_INTEGER_1DARRAY writes integer presicions 1-D array data +! WRITE_INTEGER_1DARRAY writes integer precision 1-D array data !=============================================================================== subroutine write_integer_1Darray(self, buffer, name, group, length, collect)