From 60c6dea71d201fac69eeb1812dcabfb632163ab7 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 30 Jul 2013 17:26:30 -0400 Subject: [PATCH 01/42] 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/42] 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/42] 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/42] 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/42] 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/42] 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/42] 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/42] 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/42] 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/42] 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/42] 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/42] 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/42] 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/42] 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/42] 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/42] 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/42] 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 077431f1e5a1a6211dde36b1e83307b47ee204c7 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 16 Aug 2013 09:18:02 -0500 Subject: [PATCH 18/42] Added OpenMP shared memory parallelism based on changes in threading branch. Works for ifort, but not for gfortran. --- src/Makefile | 24 ++++++++++++++++-- src/ace.F90 | 2 ++ src/cross_section.F90 | 17 ++++++++----- src/eigenvalue.F90 | 52 ++++++++++++++++++++++++++++++++++++++- src/geometry.F90 | 35 +++++++++++++++----------- src/global.F90 | 11 +++++++++ src/initialize.F90 | 26 ++++++++++++++++++-- src/physics.F90 | 32 +++++++++++++++--------- src/random_lcg.F90 | 2 ++ src/source.F90 | 3 ++- src/tally.F90 | 53 ++++++++++++++++++++++++++++------------ src/tracking.F90 | 6 ++++- src/xml-fortran/Makefile | 2 +- 13 files changed, 210 insertions(+), 55 deletions(-) diff --git a/src/Makefile b/src/Makefile index 6107c37adc..2369e29fba 100644 --- a/src/Makefile +++ b/src/Makefile @@ -17,6 +17,7 @@ DEBUG = no PROFILE = no OPTIMIZE = no MPI = no +OPENMP = no HDF5 = no PETSC = no @@ -179,6 +180,25 @@ else endif endif +# OpenMP for shared-memory parallelism + +ifeq ($(OPENMP),yes) + ifeq ($(COMPILER),intel) + F90FLAGS += -openmp -DOPENMP + LDFLAGS += -openmp + endif + + ifeq ($(COMPILER),gnu) + F90FLAGS += -fopenmp -DOPENMP + LDFLAGS += -fopenmp + endif + + ifeq ($(COMPILER),ibm) + F90FLAGS += -qsmp=omp -WF,-DOPENMP + LDFLAGS += -qsmp=omp + endif +endif + # PETSC for CMFD functionality ifeq ($(PETSC),yes) @@ -225,8 +245,8 @@ endif all: xml-fortran $(program) xml-fortran: - cd xml-fortran; make MACHINE=$(MACHINE) F90=$(F90) F90FLAGS="$(F90FLAGS)" - cd templates; make F90=$(F90) F90FLAGS="$(F90FLAGS)" + cd xml-fortran; make MACHINE=$(MACHINE) F90=$(F90) F90FLAGS="$(F90FLAGS)" LDFLAGS="$(LDFLAGS)" + cd templates; make F90=$(F90) F90FLAGS="$(F90FLAGS)" LDFLAGS="$(LDFLAGS)" $(program): $(objects) $(F90) $(objects) $(templates) $(xml_fort) $(LDFLAGS) -o $@ install: diff --git a/src/ace.F90 b/src/ace.F90 index 2617bcbed4..ab67b3e09d 100644 --- a/src/ace.F90 +++ b/src/ace.F90 @@ -51,7 +51,9 @@ contains ! allocate arrays for ACE table storage and cross section cache allocate(nuclides(n_nuclides_total)) allocate(sab_tables(n_sab_tables)) +!$omp parallel allocate(micro_xs(n_nuclides_total)) +!$omp end parallel ! ========================================================================== ! READ ALL ACE CROSS SECTION TABLES diff --git a/src/cross_section.F90 b/src/cross_section.F90 index be9f0740a1..4c9ffb8c88 100644 --- a/src/cross_section.F90 +++ b/src/cross_section.F90 @@ -14,6 +14,7 @@ module cross_section save integer :: union_grid_index +!$omp threadprivate(union_grid_index) contains @@ -32,7 +33,8 @@ contains integer :: j ! index in mat % i_sab_nuclides real(8) :: atom_density ! atom density of a nuclide logical :: check_sab ! should we check for S(a,b) table? - type(Material), pointer :: mat => null() ! current material + type(Material), pointer, save :: mat => null() ! current material +!$omp threadprivate(mat) ! Set all material macroscopic cross sections to zero material_xs % total = ZERO @@ -139,7 +141,8 @@ contains integer :: i_grid ! index on nuclide energy grid real(8) :: f ! interp factor on nuclide energy grid - type(Nuclide), pointer :: nuc => null() + type(Nuclide), pointer, save :: nuc => null() +!$omp threadprivate(nuc) ! Set pointer to nuclide nuc => nuclides(i_nuclide) @@ -258,7 +261,8 @@ contains real(8) :: f ! interp factor on S(a,b) energy grid real(8) :: inelastic ! S(a,b) inelastic cross section real(8) :: elastic ! S(a,b) elastic cross section - type(SAlphaBeta), pointer :: sab => null() + type(SAlphaBeta), pointer, save :: sab => null() +!$omp threadprivate(sab) ! Set flag that S(a,b) treatment should be used for scattering micro_xs(i_nuclide) % index_sab = i_sab @@ -346,9 +350,10 @@ contains real(8) :: capture ! (n,gamma) cross section real(8) :: fission ! fission cross section real(8) :: inelastic ! inelastic cross section - type(UrrData), pointer :: urr => null() - type(Nuclide), pointer :: nuc => null() - type(Reaction), pointer :: rxn => null() + type(UrrData), pointer, save :: urr => null() + type(Nuclide), pointer, save :: nuc => null() + type(Reaction), pointer, save :: rxn => null() +!$omp threadprivate(urr, nuc, rxn) micro_xs(i_nuclide) % use_ptable = .true. diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index 99e758bf38..f52ccef810 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -39,6 +39,7 @@ contains subroutine run_eigenvalue() type(Particle) :: p + integer :: i_work if (master) call header("K EIGENVALUE SIMULATION", level=1) @@ -71,7 +72,9 @@ contains ! ==================================================================== ! LOOP OVER PARTICLES - PARTICLE_LOOP: do current_work = 1, work +!$omp parallel do schedule(static) firstprivate(p) + PARTICLE_LOOP: do i_work = 1, work + current_work = i_work ! grab source particle from bank call get_source_particle(p, current_work) @@ -80,6 +83,7 @@ contains call transport(p) end do PARTICLE_LOOP +!$omp end parallel do ! Accumulate time for transport call time_transport % stop() @@ -157,6 +161,11 @@ contains subroutine finalize_generation() +#ifdef OPENMP + ! Join the fission bank from each thread into one global fission bank + call join_bank_from_threads() +#endif + ! Distribute fission bank across processors evenly call time_bank % start() call synchronize_bank() @@ -808,4 +817,45 @@ contains end subroutine replay_batch_history +#ifdef OPENMP +!=============================================================================== +! JOIN_BANK_FROM_THREADS +!=============================================================================== + + subroutine join_bank_from_threads() + + integer :: total ! total number of fission bank sites + integer :: i ! loop index for threads + + ! Initialize the total number of fission bank sites + total = 0 + +!$omp parallel + + ! Copy thread fission bank sites to one shared copy +!$omp do ordered schedule(static) + do i = 1, n_threads +!$omp ordered + master_fission_bank(total+1:total+n_bank) = fission_bank(1:n_bank) + total = total + n_bank +!$omp end ordered + end do +!$omp end do + + ! Make sure all threads have made it to this point +!$omp barrier + + ! Now copy the shared fission bank sites back to the master thread's copy. + if (thread_id == 0) then + n_bank = total + fission_bank(1:n_bank) = master_fission_bank(1:n_bank) + else + n_bank = 0 + end if + +!$omp end parallel + + end subroutine join_bank_from_threads +#endif + end module eigenvalue diff --git a/src/geometry.F90 b/src/geometry.F90 index a50e55252a..547ad21d36 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -29,7 +29,8 @@ contains integer :: i_surface ! index in surfaces array (with sign) logical :: specified_sense ! specified sense of surface in list logical :: actual_sense ! sense of particle wrt surface - type(Surface), pointer :: s => null() + type(Surface), pointer, save :: s => null() +!$omp threadprivate(s) SURFACE_LOOP: do i = 1, c % n_surfaces ! Lookup surface @@ -76,9 +77,10 @@ contains integer :: i ! cell loop index on a level integer :: n ! number of cells to search on a level integer :: index_cell ! index in cells array - type(Cell), pointer :: c ! pointer to cell - type(Universe), pointer :: univ ! universe to search in - type(LocalCoord), pointer :: coord ! particle coordinate to search on + type(Cell), pointer, save :: c => null() ! pointer to cell + type(Universe), pointer, save :: univ => null() ! universe to search in + type(LocalCoord), pointer, save :: coord => null() ! particle coordinate to search on +!$omp threadprivate(c, univ, coord) coord => p % coord0 @@ -139,9 +141,10 @@ contains logical :: use_search_cells ! use cells provided as argument logical :: outside_lattice ! if particle is not inside lattice bounds logical :: lattice_edge ! if particle is on a lattice edge - type(Cell), pointer :: c ! pointer to cell - type(Lattice), pointer :: lat ! pointer to lattice - type(Universe), pointer :: univ ! universe to search in + type(Cell), pointer, save :: c => null() ! pointer to cell + type(Lattice), pointer, save :: lat => null() ! pointer to lattice + type(Universe), pointer, save :: univ => null() ! universe to search in +!$omp threadprivate(c, lat, univ) ! Remove coordinates for any lower levels call deallocate_coord(p % coord % next) @@ -375,7 +378,8 @@ contains real(8) :: norm ! "norm" of surface normal integer :: i_surface ! index in surfaces logical :: found ! particle found in universe? - type(Surface), pointer :: surf => null() + type(Surface), pointer, save :: surf => null() +!$omp threadprivate(surf) i_surface = abs(p % surface) surf => surfaces(i_surface) @@ -658,7 +662,8 @@ contains integer :: n_x, n_y, n_z ! size of lattice real(8) :: x0, y0, z0 ! half width of lattice element logical :: found ! particle found in cell? - type(Lattice), pointer :: lat => null() + type(Lattice), pointer, save :: lat => null() +!$omp threadprivate(lat) lat => lattices(p % coord % lattice) @@ -787,11 +792,12 @@ contains real(8) :: a,b,c,k ! quadratic equation coefficients real(8) :: quad ! discriminant of quadratic equation logical :: on_surface ! is particle on surface? - type(Cell), pointer :: cl => null() - type(Surface), pointer :: surf => null() - type(Lattice), pointer :: lat => null() - type(LocalCoord), pointer :: coord => null() - type(LocalCoord), pointer :: final_coord => null() + type(Cell), pointer, save :: cl => null() + type(Surface), pointer, save :: surf => null() + type(Lattice), pointer, save :: lat => null() + type(LocalCoord), pointer, save :: coord => null() + type(LocalCoord), pointer, save :: final_coord => null() +!$omp threadprivate(cl, surf, lat, coord, final_coord) ! inialize distance to infinity (huge) dist = INFINITY @@ -1562,6 +1568,7 @@ contains ! Increment number of lost particles p % alive = .false. +!$omp atomic n_lost_particles = n_lost_particles + 1 ! Abort the simulation if the maximum number of lost particles has been diff --git a/src/global.F90 b/src/global.F90 index a7a7bfb972..a84e9b00b8 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -159,6 +159,9 @@ module global ! Source and fission bank type(Bank), allocatable, target :: source_bank(:) type(Bank), allocatable, target :: fission_bank(:) +#ifdef OPENMP + type(Bank), allocatable, target :: master_fission_bank(:) +#endif integer(8) :: n_bank ! # of sites in fission bank integer(8) :: bank_first ! index of first particle in bank integer(8) :: bank_last ! index of last particle in bank @@ -205,6 +208,11 @@ module global integer :: MPI_BANK ! MPI datatype for fission bank integer :: MPI_TALLYRESULT ! MPI datatype for TallyResult +#ifdef OPENMP + integer :: n_threads ! number of OpenMP threads + integer :: thread_id ! ID of a given thread +#endif + ! No reduction at end of batch logical :: reduce_tallies = .true. @@ -375,6 +383,9 @@ module global logical :: output_xs = .false. logical :: output_tallies = .true. +!$omp threadprivate(micro_xs, material_xs, fission_bank, n_bank, message, & +!$omp& trace, thread_id, current_work) + contains !=============================================================================== diff --git a/src/initialize.F90 b/src/initialize.F90 index da9194915c..03ee0045a1 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -26,6 +26,10 @@ module initialize use mpi #endif +#ifdef OPENMP + use omp_lib +#endif + #ifdef HDF5 use hdf5_interface use hdf5_summary, only: hdf5_write_summary @@ -761,7 +765,7 @@ contains subroutine allocate_banks() - integer :: alloc_err ! allocation error code + integer :: alloc_err ! allocation error code ! Allocate source bank allocate(source_bank(maxwork), STAT=alloc_err) @@ -772,8 +776,26 @@ contains call fatal_error() end if - ! Allocate fission bank +#ifdef OPENMP + ! If OpenMP is being used, each thread needs its own private fission + ! bank. Since the private fission banks need to be combined at the end of a + ! generation, there is also a 'master_fission_bank' that is used to collect + ! the sites from each thread. + +!$omp parallel + n_threads = omp_get_num_threads() + thread_id = omp_get_thread_num() + + if (thread_id == 0) then + allocate(fission_bank(3*maxwork)) + else + allocate(fission_bank(3*maxwork/n_threads)) + end if +!$omp end parallel + allocate(master_fission_bank(3*maxwork), STAT=alloc_err) +#else allocate(fission_bank(3*maxwork), STAT=alloc_err) +#endif ! Check for allocation errors if (alloc_err /= 0) then diff --git a/src/physics.F90 b/src/physics.F90 index a8325b2d87..500d32477a 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -74,7 +74,8 @@ contains integer :: i_nuclide ! index in nuclides array integer :: i_reaction ! index in nuc % reactions array - type(Nuclide), pointer :: nuc => null() + type(Nuclide), pointer, save :: nuc => null() +!$omp threadprivate(nuc) i_nuclide = sample_nuclide(p, 'total ') @@ -129,7 +130,8 @@ contains real(8) :: cutoff real(8) :: atom_density ! atom density of nuclide in atom/b-cm real(8) :: sigma ! microscopic total xs for nuclide - type(Material), pointer :: mat => null() + type(Material), pointer, save :: mat => null() +!$omp threadprivate(mat) ! Get pointer to current material mat => materials(p % material) @@ -191,8 +193,9 @@ contains real(8) :: f real(8) :: prob real(8) :: cutoff - type(Nuclide), pointer :: nuc => null() - type(Reaction), pointer :: rxn => null() + type(Nuclide), pointer, save :: nuc => null() + type(Reaction), pointer, save :: rxn => null() +!$omp threadprivate(nuc, rxn) ! Get pointer to nuclide nuc => nuclides(i_nuclide) @@ -251,6 +254,7 @@ contains p % last_wgt = p % wgt ! Score implicit absorption estimate of keff +!$omp atomic global_tallies(K_ABSORPTION) % value = & global_tallies(K_ABSORPTION) % value + p % absorb_wgt * & micro_xs(i_nuclide) % nu_fission / micro_xs(i_nuclide) % absorption @@ -260,6 +264,7 @@ contains if (micro_xs(i_nuclide) % absorption > & prn() * micro_xs(i_nuclide) % total) then ! Score absorption estimate of keff +!$omp atomic global_tallies(K_ABSORPTION) % value = & global_tallies(K_ABSORPTION) % value + p % wgt * & micro_xs(i_nuclide) % nu_fission / micro_xs(i_nuclide) % absorption @@ -306,8 +311,9 @@ contains real(8) :: f real(8) :: prob real(8) :: cutoff - type(Nuclide), pointer :: nuc => null() - type(Reaction), pointer :: rxn => null() + type(Nuclide), pointer, save :: nuc => null() + type(Reaction), pointer, save :: rxn => null() +!$omp threadprivate(nuc, rxn) ! Get pointer to nuclide and grid index/interpolation factor nuc => nuclides(i_nuclide) @@ -410,7 +416,8 @@ contains real(8) :: v_cm(3) ! velocity of center-of-mass real(8) :: v_t(3) ! velocity of target nucleus real(8) :: uvw_cm(3) ! directional cosines in center-of-mass - type(Nuclide), pointer :: nuc => null() + type(Nuclide), pointer, save :: nuc => null() +!$omp threadprivate(nuc) ! get pointer to nuclide nuc => nuclides(i_nuclide) @@ -487,7 +494,8 @@ contains real(8) :: mu_ijk ! outgoing cosine k for E_in(i) and E_out(j) real(8) :: mu_i1jk ! outgoing cosine k for E_in(i+1) and E_out(j) real(8) :: prob ! probability for sampling Bragg edge - type(SAlphaBeta), pointer :: sab => null() + type(SAlphaBeta), pointer, save :: sab => null() +!$omp threadprivate(sab) ! Get pointer to S(a,b) table sab => sab_tables(i_sab) @@ -715,8 +723,9 @@ contains real(8) :: phi ! fission neutron azimuthal angle real(8) :: weight ! weight adjustment for ufs method logical :: in_mesh ! source site in ufs mesh? - type(Nuclide), pointer :: nuc => null() - type(Reaction), pointer :: rxn => null() + type(Nuclide), pointer, save :: nuc => null() + type(Reaction), pointer, save :: rxn => null() +!$omp threadprivate(nuc, rxn) ! Get pointers nuc => nuclides(i_nuclide) @@ -815,7 +824,8 @@ contains real(8) :: xi ! random number real(8) :: yield ! delayed neutron precursor yield real(8) :: prob ! cumulative probability - type(DistEnergy), pointer :: edist => null() + type(DistEnergy), pointer, save :: edist => null() +!$omp threadprivate(edist) ! Determine total nu nu_t = nu_total(nuc, E) diff --git a/src/random_lcg.F90 b/src/random_lcg.F90 index 3130d42a53..83ff6409f9 100644 --- a/src/random_lcg.F90 +++ b/src/random_lcg.F90 @@ -15,6 +15,8 @@ module random_lcg integer(8) :: prn_stride ! stride between particles real(8) :: prn_norm ! 2^(-M) +!$omp threadprivate(prn_seed) + public :: prn public :: initialize_prng public :: set_particle_seed diff --git a/src/source.F90 b/src/source.F90 index c951c11ffa..6f2bad2477 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -155,7 +155,8 @@ contains integer(8), intent(in) :: index_source integer(8) :: particle_seed ! unique index for particle - type(Bank), pointer :: src => null() + type(Bank), pointer, save :: src => null() +!$omp threadprivate(src) ! set defaults call p % initialize() diff --git a/src/tally.F90 b/src/tally.F90 index 8550473e4a..49a06140bb 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -23,6 +23,7 @@ module tally ! Tally map positioning array integer :: position(N_FILTER_TYPES - 3) = 0 +!$omp threadprivate(position) contains @@ -54,7 +55,8 @@ contains real(8) :: macro_total ! material macro total xs real(8) :: macro_scatt ! material macro scatt xs logical :: found_bin ! scoring bin found? - type(TallyObject), pointer :: t => null() + type(TallyObject), pointer, save :: t => null() +!$omp threadprivate(t) ! Copy particle's pre- and post-collision weight and angle last_wgt = p % last_wgt @@ -200,6 +202,7 @@ contains ! get the score and tally it score = last_wgt * calc_pn(n, mu) +!$omp atomic t % results(score_index, filter_index) % value = & t % results(score_index, filter_index) % value + score end do @@ -338,6 +341,7 @@ contains end select ! Add score to tally +!$omp atomic t % results(score_index, filter_index) % value = & t % results(score_index, filter_index) % value + score @@ -411,6 +415,7 @@ contains i_filter = sum((t % matching_bins - 1) * t % stride) + 1 ! Add score to tally +!$omp atomic t % results(i_score, i_filter) % value = & t % results(i_score, i_filter) % value + score end do @@ -449,9 +454,10 @@ contains real(8) :: score ! actual score (e.g., flux*xs) real(8) :: atom_density ! atom density of single nuclide in atom/b-cm logical :: found_bin ! scoring bin found? - type(TallyObject), pointer :: t => null() - type(Material), pointer :: mat => null() - type(Reaction), pointer :: rxn => null() + type(TallyObject), pointer, save :: t => null() + type(Material), pointer, save :: mat => null() + type(Reaction), pointer, save :: rxn => null() +!$omp threadprivate(t, mat, rxn) ! Determine track-length estimate of flux flux = p % wgt * distance @@ -698,6 +704,7 @@ contains score_index = (k - 1)*t % n_score_bins + j ! Add score to tally +!$omp atomic t % results(score_index, filter_index) % value = & t % results(score_index, filter_index) % value + score @@ -742,9 +749,10 @@ contains real(8) :: f ! interpolation factor real(8) :: score ! actual scoring tally value real(8) :: atom_density ! atom density of single nuclide in atom/b-cm - type(TallyObject), pointer :: t => null() - type(Material), pointer :: mat => null() - type(Reaction), pointer :: rxn => null() + type(TallyObject), pointer, save :: t => null() + type(Material), pointer, save :: mat => null() + type(Reaction), pointer, save :: rxn => null() +!$omp threadprivate(t, mat, rxn) ! Get pointer to tally t => tallies(i_tally) @@ -840,6 +848,7 @@ contains score_index = (i_nuclide - 1)*t % n_score_bins + j ! Add score to tally +!$omp atomic t % results(score_index, filter_index) % value = & t % results(score_index, filter_index) % value + score @@ -938,6 +947,7 @@ contains score_index = n_nuclides_total*t % n_score_bins + j ! Add score to tally +!$omp atomic t % results(score_index, filter_index) % value = & t % results(score_index, filter_index) % value + score @@ -982,10 +992,11 @@ contains logical :: found_bin ! was a scoring bin found? logical :: start_in_mesh ! starting coordinates inside mesh? logical :: end_in_mesh ! ending coordinates inside mesh? - type(TallyObject), pointer :: t => null() - type(StructuredMesh), pointer :: m => null() - type(Material), pointer :: mat => null() - type(LocalCoord), pointer :: coord => null() + type(TallyObject), pointer, save :: t => null() + type(StructuredMesh), pointer, save :: m => null() + type(Material), pointer, save :: mat => null() + type(LocalCoord), pointer, save :: coord => null() +!$omp threadprivate(t, m, mat, coord) t => tallies(i_tally) t % matching_bins = 1 @@ -1245,6 +1256,7 @@ contains score_index = (b - 1)*t % n_score_bins + j ! Add score to tally +!$omp atomic t % results(score_index, filter_index) % value = & t % results(score_index, filter_index) % value + score @@ -1275,9 +1287,10 @@ contains integer :: i ! loop index for filters integer :: n ! number of bins for single filter real(8) :: E ! particle energy - type(TallyObject), pointer :: t => null() - type(StructuredMesh), pointer :: m => null() - type(LocalCoord), pointer :: coord => null() + type(TallyObject), pointer, save :: t => null() + type(StructuredMesh), pointer, save :: m => null() + type(LocalCoord), pointer, save :: coord => null() +!$omp threadprivate(t, m, coord) found_bin = .true. t => tallies(i_tally) @@ -1403,8 +1416,9 @@ contains logical :: x_same ! same starting/ending x index (i) logical :: y_same ! same starting/ending y index (j) logical :: z_same ! same starting/ending z index (k) - type(TallyObject), pointer :: t => null() - type(StructuredMesh), pointer :: m => null() + type(TallyObject), pointer, save :: t => null() + type(StructuredMesh), pointer, save :: m => null() +!$omp threadprivate(t, m) TALLY_LOOP: do i = 1, active_current_tallies % size() ! Copy starting and ending location of particle @@ -1475,6 +1489,7 @@ contains t % matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) filter_index = sum((t % matching_bins - 1) * t % stride) + 1 +!$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt end if @@ -1487,6 +1502,7 @@ contains t % matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) filter_index = sum((t % matching_bins - 1) * t % stride) + 1 +!$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt end if @@ -1503,6 +1519,7 @@ contains t % matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) filter_index = sum((t % matching_bins - 1) * t % stride) + 1 +!$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt end if @@ -1515,6 +1532,7 @@ contains t % matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) filter_index = sum((t % matching_bins - 1) * t % stride) + 1 +!$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt end if @@ -1531,6 +1549,7 @@ contains t % matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) filter_index = sum((t % matching_bins - 1) * t % stride) + 1 +!$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt end if @@ -1543,6 +1562,7 @@ contains t % matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) filter_index = sum((t % matching_bins - 1) * t % stride) + 1 +!$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt end if @@ -1667,6 +1687,7 @@ contains end if ! Add to surface current tally +!$omp atomic t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt end if diff --git a/src/tracking.F90 b/src/tracking.F90 index aee90ea52c..6080b2bae1 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -32,7 +32,8 @@ contains real(8) :: d_collision ! sampled distance to collision real(8) :: distance ! distance particle travels logical :: found_cell ! found cell which particle is in? - type(LocalCoord), pointer :: coord => null() + type(LocalCoord), pointer, save :: coord => null() +!$omp threadprivate(coord) ! Display message if high verbosity or trace is on if (verbosity >= 9 .or. trace) then @@ -59,6 +60,7 @@ contains n_event = 0 ! Add paricle's starting weight to count for normalizing tallies later +!$omp atomic total_weight = total_weight + p % wgt ! Force calculation of cross-sections by setting last energy to zero @@ -99,6 +101,7 @@ contains call score_tracklength_tally(p, distance) ! Score track-length estimate of k-eff +!$omp atomic global_tallies(K_TRACKLENGTH) % value = & global_tallies(K_TRACKLENGTH) % value + p % wgt * distance * & material_xs % nu_fission @@ -125,6 +128,7 @@ contains ! PARTICLE HAS COLLISION ! Score collision estimate of keff +!$omp atomic global_tallies(K_COLLISION) % value = & global_tallies(K_COLLISION) % value + p % wgt * & material_xs % nu_fission / material_xs % total diff --git a/src/xml-fortran/Makefile b/src/xml-fortran/Makefile index c0514533a3..6bba7a1486 100644 --- a/src/xml-fortran/Makefile +++ b/src/xml-fortran/Makefile @@ -22,7 +22,7 @@ endif all: $(reader) $(reader): $(objects) - $(F90) $(objects) -o $@ + $(F90) $(objects) $(LDFLAGS) -o $@ clean: @rm -f *.o *.mod $(reader) neat: From 31db2828022caeabd60ec8a04561ba8ceab4edf7 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 16 Aug 2013 17:31:56 -0500 Subject: [PATCH 19/42] Changed all atomics to criticals. gfortran now produce correct k-effective. --- src/physics.F90 | 6 ++++-- src/tally.F90 | 42 ++++++++++++++++++++++++++++-------------- src/tracking.F90 | 9 ++++++--- 3 files changed, 38 insertions(+), 19 deletions(-) diff --git a/src/physics.F90 b/src/physics.F90 index 500d32477a..e475655e3d 100644 --- a/src/physics.F90 +++ b/src/physics.F90 @@ -254,20 +254,22 @@ contains p % last_wgt = p % wgt ! Score implicit absorption estimate of keff -!$omp atomic +!$omp critical global_tallies(K_ABSORPTION) % value = & global_tallies(K_ABSORPTION) % value + p % absorb_wgt * & micro_xs(i_nuclide) % nu_fission / micro_xs(i_nuclide) % absorption +!$omp end critical else ! See if disappearance reaction happens if (micro_xs(i_nuclide) % absorption > & prn() * micro_xs(i_nuclide) % total) then ! Score absorption estimate of keff -!$omp atomic +!$omp critical global_tallies(K_ABSORPTION) % value = & global_tallies(K_ABSORPTION) % value + p % wgt * & micro_xs(i_nuclide) % nu_fission / micro_xs(i_nuclide) % absorption +!$omp end critical p % alive = .false. p % event = EVENT_ABSORB diff --git a/src/tally.F90 b/src/tally.F90 index 49a06140bb..2fafacf320 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -202,9 +202,10 @@ contains ! get the score and tally it score = last_wgt * calc_pn(n, mu) -!$omp atomic +!$omp critical t % results(score_index, filter_index) % value = & t % results(score_index, filter_index) % value + score +!$omp end critical end do j = j + t % scatt_order(j) cycle SCORE_LOOP @@ -341,9 +342,10 @@ contains end select ! Add score to tally -!$omp atomic +!$omp critical t % results(score_index, filter_index) % value = & t % results(score_index, filter_index) % value + score +!$omp end critical end do SCORE_LOOP @@ -415,9 +417,10 @@ contains i_filter = sum((t % matching_bins - 1) * t % stride) + 1 ! Add score to tally -!$omp atomic +!$omp critical t % results(i_score, i_filter) % value = & t % results(i_score, i_filter) % value + score +!$omp end critical end do ! reset outgoing energy bin and score index @@ -704,9 +707,10 @@ contains score_index = (k - 1)*t % n_score_bins + j ! Add score to tally -!$omp atomic +!$omp critical t % results(score_index, filter_index) % value = & t % results(score_index, filter_index) % value + score +!$omp end critical end do SCORE_LOOP @@ -848,9 +852,10 @@ contains score_index = (i_nuclide - 1)*t % n_score_bins + j ! Add score to tally -!$omp atomic +!$omp critical t % results(score_index, filter_index) % value = & t % results(score_index, filter_index) % value + score +!$omp end critical end do SCORE_LOOP @@ -947,9 +952,10 @@ contains score_index = n_nuclides_total*t % n_score_bins + j ! Add score to tally -!$omp atomic +!$omp critical t % results(score_index, filter_index) % value = & t % results(score_index, filter_index) % value + score +!$omp end critical end do MATERIAL_SCORE_LOOP @@ -1256,9 +1262,10 @@ contains score_index = (b - 1)*t % n_score_bins + j ! Add score to tally -!$omp atomic +!$omp critical t % results(score_index, filter_index) % value = & t % results(score_index, filter_index) % value + score +!$omp end critical end do SCORE_LOOP @@ -1489,9 +1496,10 @@ contains t % matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) filter_index = sum((t % matching_bins - 1) * t % stride) + 1 -!$omp atomic +!$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt +!$omp end critical end if end do else @@ -1502,9 +1510,10 @@ contains t % matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) filter_index = sum((t % matching_bins - 1) * t % stride) + 1 -!$omp atomic +!$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt +!$omp end critical end if end do end if @@ -1519,9 +1528,10 @@ contains t % matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) filter_index = sum((t % matching_bins - 1) * t % stride) + 1 -!$omp atomic +!$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt +!$omp end critical end if end do else @@ -1532,9 +1542,10 @@ contains t % matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) filter_index = sum((t % matching_bins - 1) * t % stride) + 1 -!$omp atomic +!$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt +!$omp end critical end if end do end if @@ -1549,9 +1560,10 @@ contains t % matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) filter_index = sum((t % matching_bins - 1) * t % stride) + 1 -!$omp atomic +!$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt +!$omp end critical end if end do else @@ -1562,9 +1574,10 @@ contains t % matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) filter_index = sum((t % matching_bins - 1) * t % stride) + 1 -!$omp atomic +!$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt +!$omp end critical end if end do end if @@ -1687,9 +1700,10 @@ contains end if ! Add to surface current tally -!$omp atomic +!$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt +!$omp end critical end if ! Calculate new coordinates diff --git a/src/tracking.F90 b/src/tracking.F90 index 6080b2bae1..0ceb5d7e8f 100644 --- a/src/tracking.F90 +++ b/src/tracking.F90 @@ -60,8 +60,9 @@ contains n_event = 0 ! Add paricle's starting weight to count for normalizing tallies later -!$omp atomic +!$omp critical total_weight = total_weight + p % wgt +!$omp end critical ! Force calculation of cross-sections by setting last energy to zero micro_xs % last_E = ZERO @@ -101,10 +102,11 @@ contains call score_tracklength_tally(p, distance) ! Score track-length estimate of k-eff -!$omp atomic +!$omp critical global_tallies(K_TRACKLENGTH) % value = & global_tallies(K_TRACKLENGTH) % value + p % wgt * distance * & material_xs % nu_fission +!$omp end critical if (d_collision > d_boundary) then ! ==================================================================== @@ -128,10 +130,11 @@ contains ! PARTICLE HAS COLLISION ! Score collision estimate of keff -!$omp atomic +!$omp critical global_tallies(K_COLLISION) % value = & global_tallies(K_COLLISION) % value + p % wgt * & material_xs % nu_fission / material_xs % total +!$omp end critical ! score surface current tallies -- this has to be done before the collision ! since the direction of the particle will change and we need to use the From be05b1ce55a62614a604ec10628eac7435e450e6 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 16 Aug 2013 19:34:51 -0500 Subject: [PATCH 20/42] Removed matching_bins from TallyObject type and made it threadprivate. Still have race condition with Lists. --- src/cmfd_data.F90 | 85 ++++++++++++------------- src/global.F90 | 3 +- src/output.F90 | 76 +++++++++++------------ src/tally.F90 | 130 +++++++++++++++++++-------------------- src/tally_header.F90 | 3 - src/tally_initialize.F90 | 14 +++-- 6 files changed, 158 insertions(+), 153 deletions(-) diff --git a/src/cmfd_data.F90 b/src/cmfd_data.F90 index 9943379784..a552b9d000 100644 --- a/src/cmfd_data.F90 +++ b/src/cmfd_data.F90 @@ -57,7 +57,8 @@ contains FILTER_SURFACE, IN_RIGHT, OUT_RIGHT, IN_FRONT, & OUT_FRONT, IN_TOP, OUT_TOP, CMFD_NOACCEL, ZERO, ONE use error, only: fatal_error - use global, only: cmfd, message, n_cmfd_tallies, cmfd_tallies, meshes + use global, only: cmfd, message, n_cmfd_tallies, cmfd_tallies, meshes,& + matching_bins use mesh, only: mesh_indices_to_bin use mesh_header, only: StructuredMesh use tally_header, only: TallyObject @@ -137,21 +138,21 @@ contains TALLY: if (ital == 1) then ! reset all bins to 1 - t % matching_bins = 1 + matching_bins(1:t%n_filters) = 1 ! set ijk as mesh indices ijk = (/ i, j, k /) ! get bin number for mesh indices - t % matching_bins(i_filter_mesh) = mesh_indices_to_bin(m,ijk) + matching_bins(i_filter_mesh) = mesh_indices_to_bin(m,ijk) ! apply energy in filter if (i_filter_ein > 0) then - t % matching_bins(i_filter_ein) = ng - h + 1 + matching_bins(i_filter_ein) = ng - h + 1 end if ! calculate score index from bins - score_index = sum((t % matching_bins - 1) * t%stride) + 1 + score_index = sum((matching_bins(1:t%n_filters) - 1) * t%stride) + 1 ! get flux flux = t % results(1,score_index) % sum @@ -180,24 +181,24 @@ contains INGROUP: do g = 1, ng ! reset all bins to 1 - t % matching_bins = 1 + matching_bins(1:t%n_filters) = 1 ! set ijk as mesh indices ijk = (/ i, j, k /) ! get bin number for mesh indices - t % matching_bins(i_filter_mesh) = mesh_indices_to_bin(m,ijk) + matching_bins(i_filter_mesh) = mesh_indices_to_bin(m,ijk) if (i_filter_ein > 0) then ! apply energy in filter - t % matching_bins(i_filter_ein) = ng - h + 1 + matching_bins(i_filter_ein) = ng - h + 1 ! set energy out bin - t % matching_bins(i_filter_eout) = ng - g + 1 + matching_bins(i_filter_eout) = ng - g + 1 end if ! calculate score index from bins - score_index = sum((t % matching_bins - 1) * t%stride) + 1 + score_index = sum((matching_bins(1:t%n_filters) - 1) * t%stride) + 1 ! get scattering cmfd % scattxs(h,g,i,j,k) = t % results(1,score_index) % sum /& @@ -216,69 +217,69 @@ contains else if (ital == 3) then ! initialize and filter for energy - t % matching_bins = 1 + matching_bins(1:t%n_filters) = 1 if (i_filter_ein > 0) then - t % matching_bins(i_filter_ein) = ng - h + 1 + matching_bins(i_filter_ein) = ng - h + 1 end if ! left surface - t % matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & + matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & (/ i-1, j, k /) + 1, .true.) - t % matching_bins(i_filter_surf) = IN_RIGHT - score_index = sum((t % matching_bins - 1) * t % stride) + 1 ! outgoing + matching_bins(i_filter_surf) = IN_RIGHT + score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! outgoing cmfd % current(1,h,i,j,k) = t % results(1,score_index) % sum - t % matching_bins(i_filter_surf) = OUT_RIGHT - score_index = sum((t % matching_bins - 1) * t % stride) + 1 ! incoming + matching_bins(i_filter_surf) = OUT_RIGHT + score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! incoming cmfd % current(2,h,i,j,k) = t % results(1,score_index) % sum ! right surface - t % matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & + matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & (/ i, j, k /) + 1, .true.) - t % matching_bins(i_filter_surf) = IN_RIGHT - score_index = sum((t % matching_bins - 1) * t % stride) + 1 ! incoming + matching_bins(i_filter_surf) = IN_RIGHT + score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! incoming cmfd % current(3,h,i,j,k) = t % results(1,score_index) % sum - t % matching_bins(i_filter_surf) = OUT_RIGHT - score_index = sum((t % matching_bins - 1) * t % stride) + 1 ! outgoing + matching_bins(i_filter_surf) = OUT_RIGHT + score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! outgoing cmfd % current(4,h,i,j,k) = t % results(1,score_index) % sum ! back surface - t % matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & + matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & (/ i, j-1, k /) + 1, .true.) - t % matching_bins(i_filter_surf) = IN_FRONT - score_index = sum((t % matching_bins - 1) * t % stride) + 1 ! outgoing + matching_bins(i_filter_surf) = IN_FRONT + score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! outgoing cmfd % current(5,h,i,j,k) = t % results(1,score_index) % sum - t % matching_bins(i_filter_surf) = OUT_FRONT - score_index = sum((t % matching_bins - 1) * t % stride) + 1 ! incoming + matching_bins(i_filter_surf) = OUT_FRONT + score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! incoming cmfd % current(6,h,i,j,k) = t % results(1,score_index) % sum ! front surface - t % matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & + matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & (/ i, j, k /) + 1, .true.) - t % matching_bins(i_filter_surf) = IN_FRONT - score_index = sum((t % matching_bins - 1) * t % stride) + 1 ! incoming + matching_bins(i_filter_surf) = IN_FRONT + score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! incoming cmfd % current(7,h,i,j,k) = t % results(1,score_index) % sum - t % matching_bins(i_filter_surf) = OUT_FRONT - score_index = sum((t % matching_bins - 1) * t % stride) + 1 ! outgoing + matching_bins(i_filter_surf) = OUT_FRONT + score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! outgoing cmfd % current(8,h,i,j,k) = t % results(1,score_index) % sum ! bottom surface - t % matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & + matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & (/ i, j, k-1 /) + 1, .true.) - t % matching_bins(i_filter_surf) = IN_TOP - score_index = sum((t % matching_bins - 1) * t % stride) + 1 ! outgoing + matching_bins(i_filter_surf) = IN_TOP + score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! outgoing cmfd % current(9,h,i,j,k) = t % results(1,score_index) % sum - t % matching_bins(i_filter_surf) = OUT_TOP - score_index = sum((t % matching_bins - 1) * t % stride) + 1 ! incoming + matching_bins(i_filter_surf) = OUT_TOP + score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! incoming cmfd % current(10,h,i,j,k) = t % results(1,score_index) % sum ! top surface - t % matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & + matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, & (/ i, j, k /) + 1, .true.) - t % matching_bins(i_filter_surf) = IN_TOP - score_index = sum((t % matching_bins - 1) * t % stride) + 1 ! incoming + matching_bins(i_filter_surf) = IN_TOP + score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! incoming cmfd % current(11,h,i,j,k) = t % results(1,score_index) % sum - t % matching_bins(i_filter_surf) = OUT_TOP - score_index = sum((t % matching_bins - 1) * t % stride) + 1 ! outgoing + matching_bins(i_filter_surf) = OUT_TOP + score_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! outgoing cmfd % current(12,h,i,j,k) = t % results(1,score_index) % sum end if TALLY diff --git a/src/global.F90 b/src/global.F90 index a84e9b00b8..dd436fefc2 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -97,6 +97,7 @@ module global type(StructuredMesh), allocatable, target :: meshes(:) type(TallyObject), allocatable, target :: tallies(:) + integer, allocatable :: matching_bins(:) ! Pointers for different tallies type(TallyObject), pointer :: user_tallies(:) => null() @@ -384,7 +385,7 @@ module global logical :: output_tallies = .true. !$omp threadprivate(micro_xs, material_xs, fission_bank, n_bank, message, & -!$omp& trace, thread_id, current_work) +!$omp& trace, thread_id, current_work, matching_bins) contains diff --git a/src/output.F90 b/src/output.F90 index 4e1d903b8e..472cb5574b 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -1644,7 +1644,7 @@ contains ! to be used for a given tally. ! Initialize bins, filter level, and indentation - t % matching_bins = 0 + matching_bins(1:t%n_filters) = 0 j = 1 indent = 0 @@ -1654,16 +1654,16 @@ contains if (t % n_filters == 0) exit find_bin ! Increment bin combination - t % matching_bins(j) = t % matching_bins(j) + 1 + matching_bins(j) = matching_bins(j) + 1 ! ================================================================= ! REACHED END OF BINS FOR THIS FILTER, MOVE TO NEXT FILTER - if (t % matching_bins(j) > t % filters(j) % n_bins) then + if (matching_bins(j) > t % filters(j) % n_bins) then ! If this is the first filter, then exit if (j == 1) exit print_bin - t % matching_bins(j) = 0 + matching_bins(j) = 0 j = j - 1 indent = indent - 2 @@ -1696,7 +1696,7 @@ contains ! bins below the lowest filter level will be zeros if (t % n_filters > 0) then - filter_index = sum((max(t % matching_bins,1) - 1) * t % stride) + 1 + filter_index = sum((max(matching_bins(1:t%n_filters),1) - 1) * t % stride) + 1 else filter_index = 1 end if @@ -1805,7 +1805,7 @@ contains m => meshes(t % filters(i_filter_mesh) % int_bins(1)) ! initialize bins array - t % matching_bins = 1 + matching_bins(1:t%n_filters) = 1 ! determine how many energy in bins there are i_filter_ein = t % find_filter(FILTER_ENERGYIN) @@ -1831,7 +1831,7 @@ contains do l = 1, n if (print_ebin) then ! Set incoming energy bin - t % matching_bins(i_filter_ein) = l + matching_bins(i_filter_ein) = l ! Write incoming energy bin write(UNIT=UNIT_TALLY, FMT='(3X,A,1X,A)') & @@ -1839,102 +1839,102 @@ contains end if ! Left Surface - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, (/ i-1, j, k /) + 1, .true.) - t % matching_bins(i_filter_surf) = IN_RIGHT - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + matching_bins(i_filter_surf) = IN_RIGHT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Left", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) - t % matching_bins(i_filter_surf) = OUT_RIGHT - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + matching_bins(i_filter_surf) = OUT_RIGHT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Left", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) ! Right Surface - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) - t % matching_bins(i_filter_surf) = IN_RIGHT - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + matching_bins(i_filter_surf) = IN_RIGHT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Right", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) - t % matching_bins(i_filter_surf) = OUT_RIGHT - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + matching_bins(i_filter_surf) = OUT_RIGHT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Right", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) ! Back Surface - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, (/ i, j-1, k /) + 1, .true.) - t % matching_bins(i_filter_surf) = IN_FRONT - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + matching_bins(i_filter_surf) = IN_FRONT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Back", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) - t % matching_bins(i_filter_surf) = OUT_FRONT - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + matching_bins(i_filter_surf) = OUT_FRONT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Back", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) ! Front Surface - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) - t % matching_bins(i_filter_surf) = IN_FRONT - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + matching_bins(i_filter_surf) = IN_FRONT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Front", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) - t % matching_bins(i_filter_surf) = OUT_FRONT - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + matching_bins(i_filter_surf) = OUT_FRONT + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Front", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) ! Bottom Surface - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, (/ i, j, k-1 /) + 1, .true.) - t % matching_bins(i_filter_surf) = IN_TOP - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + matching_bins(i_filter_surf) = IN_TOP + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Bottom", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) - t % matching_bins(i_filter_surf) = OUT_TOP - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + matching_bins(i_filter_surf) = OUT_TOP + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Bottom", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) ! Top Surface - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, (/ i, j, k /) + 1, .true.) - t % matching_bins(i_filter_surf) = IN_TOP - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + matching_bins(i_filter_surf) = IN_TOP + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Incoming Current from Top", & to_str(t % results(1,filter_index) % sum), & trim(to_str(t % results(1,filter_index) % sum_sq)) - t % matching_bins(i_filter_surf) = OUT_TOP - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + matching_bins(i_filter_surf) = OUT_TOP + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 write(UNIT=UNIT_TALLY, FMT='(5X,A,T35,A,"+/- ",A)') & "Outgoing Current to Top", & to_str(t % results(1,filter_index) % sum), & @@ -1965,7 +1965,7 @@ contains real(8) :: E1 ! upper bound for energy bin type(StructuredMesh), pointer :: m => null() - bin = t % matching_bins(i_filter) + bin = matching_bins(i_filter) select case(t % filters(i_filter) % type) case (FILTER_UNIVERSE) diff --git a/src/tally.F90 b/src/tally.F90 index 2fafacf320..e1fcc2ff06 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -85,7 +85,7 @@ contains ! be accumulating the tally values ! Determine scoring index for this filter combination - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! Check for nuclide bins k = 0 @@ -388,7 +388,7 @@ contains ! save original outgoing energy bin and score index i = t % find_filter(FILTER_ENERGYOUT) - bin_energyout = t % matching_bins(i) + bin_energyout = matching_bins(i) ! Get number of energies on filter n = size(t % filters(i) % real_bins) @@ -411,10 +411,10 @@ contains E_out > t % filters(i) % real_bins(n)) cycle ! change outgoing energy bin - t % matching_bins(i) = binary_search(t % filters(i) % real_bins, n, E_out) + matching_bins(i) = binary_search(t % filters(i) % real_bins, n, E_out) ! determine scoring index - i_filter = sum((t % matching_bins - 1) * t % stride) + 1 + i_filter = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! Add score to tally !$omp critical @@ -424,7 +424,7 @@ contains end do ! reset outgoing energy bin and score index - t % matching_bins(i) = bin_energyout + matching_bins(i) = bin_energyout end subroutine score_fission_eout @@ -495,7 +495,7 @@ contains ! be accumulating the tally values ! Determine scoring index for this filter combination - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 if (t % all_nuclides) then call score_all_nuclides(p, i_tally, flux, filter_index) @@ -1005,7 +1005,7 @@ contains !$omp threadprivate(t, m, mat, coord) t => tallies(i_tally) - t % matching_bins = 1 + matching_bins(1:t%n_filters) = 1 ! ========================================================================== ! CHECK IF THIS TRACK INTERSECTS THE MESH @@ -1045,11 +1045,11 @@ contains case (FILTER_UNIVERSE) ! determine next universe bin ! TODO: Account for multiple universes when performing this filter - t % matching_bins(i) = get_next_bin(FILTER_UNIVERSE, & + matching_bins(i) = get_next_bin(FILTER_UNIVERSE, & p % coord % universe, i_tally) case (FILTER_MATERIAL) - t % matching_bins(i) = get_next_bin(FILTER_MATERIAL, & + matching_bins(i) = get_next_bin(FILTER_MATERIAL, & p % material, i_tally) case (FILTER_CELL) @@ -1057,21 +1057,21 @@ contains coord => p % coord0 do while(associated(coord)) position(FILTER_CELL) = 0 - t % matching_bins(i) = get_next_bin(FILTER_CELL, & + matching_bins(i) = get_next_bin(FILTER_CELL, & coord % cell, i_tally) - if (t % matching_bins(i) /= NO_BIN_FOUND) exit + if (matching_bins(i) /= NO_BIN_FOUND) exit coord => coord % next end do nullify(coord) case (FILTER_CELLBORN) ! determine next cellborn bin - t % matching_bins(i) = get_next_bin(FILTER_CELLBORN, & + matching_bins(i) = get_next_bin(FILTER_CELLBORN, & p % cell_born, i_tally) case (FILTER_SURFACE) ! determine next surface bin - t % matching_bins(i) = get_next_bin(FILTER_SURFACE, & + matching_bins(i) = get_next_bin(FILTER_SURFACE, & p % surface, i_tally) case (FILTER_ENERGYIN) @@ -1081,17 +1081,17 @@ contains ! check if energy of the particle is within energy bins if (p % E < t % filters(i) % real_bins(1) .or. & p % E > t % filters(i) % real_bins(k + 1)) then - t % matching_bins(i) = NO_BIN_FOUND + matching_bins(i) = NO_BIN_FOUND else ! search to find incoming energy bin - t % matching_bins(i) = binary_search(t % filters(i) % real_bins, & + matching_bins(i) = binary_search(t % filters(i) % real_bins, & k + 1, p % E) end if end select ! Check if no matching bin was found - if (t % matching_bins(i) == NO_BIN_FOUND) return + if (matching_bins(i) == NO_BIN_FOUND) return end do FILTER_LOOP @@ -1161,10 +1161,10 @@ contains flux = p % wgt * distance ! Determine mesh bin - t % matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, ijk_cross) + matching_bins(i_filter_mesh) = mesh_indices_to_bin(m, ijk_cross) ! Determining scoring index - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 if (t % all_nuclides) then ! Score reaction rates for each nuclide in material @@ -1301,7 +1301,7 @@ contains found_bin = .true. t => tallies(i_tally) - t % matching_bins = 1 + matching_bins(1:t%n_filters) = 1 FILTER_LOOP: do i = 1, t % n_filters @@ -1311,16 +1311,16 @@ contains m => meshes(t % filters(i) % int_bins(1)) ! Determine if we're in the mesh first - call get_mesh_bin(m, p % coord0 % xyz, t % matching_bins(i)) + call get_mesh_bin(m, p % coord0 % xyz, matching_bins(i)) case (FILTER_UNIVERSE) ! determine next universe bin ! TODO: Account for multiple universes when performing this filter - t % matching_bins(i) = get_next_bin(FILTER_UNIVERSE, & + matching_bins(i) = get_next_bin(FILTER_UNIVERSE, & p % coord % universe, i_tally) case (FILTER_MATERIAL) - t % matching_bins(i) = get_next_bin(FILTER_MATERIAL, & + matching_bins(i) = get_next_bin(FILTER_MATERIAL, & p % material, i_tally) case (FILTER_CELL) @@ -1328,21 +1328,21 @@ contains coord => p % coord0 do while(associated(coord)) position(FILTER_CELL) = 0 - t % matching_bins(i) = get_next_bin(FILTER_CELL, & + matching_bins(i) = get_next_bin(FILTER_CELL, & coord % cell, i_tally) - if (t % matching_bins(i) /= NO_BIN_FOUND) exit + if (matching_bins(i) /= NO_BIN_FOUND) exit coord => coord % next end do nullify(coord) case (FILTER_CELLBORN) ! determine next cellborn bin - t % matching_bins(i) = get_next_bin(FILTER_CELLBORN, & + matching_bins(i) = get_next_bin(FILTER_CELLBORN, & p % cell_born, i_tally) case (FILTER_SURFACE) ! determine next surface bin - t % matching_bins(i) = get_next_bin(FILTER_SURFACE, & + matching_bins(i) = get_next_bin(FILTER_SURFACE, & p % surface, i_tally) case (FILTER_ENERGYIN) @@ -1359,10 +1359,10 @@ contains ! check if energy of the particle is within energy bins if (E < t % filters(i) % real_bins(1) .or. & E > t % filters(i) % real_bins(n + 1)) then - t % matching_bins(i) = NO_BIN_FOUND + matching_bins(i) = NO_BIN_FOUND else ! search to find incoming energy bin - t % matching_bins(i) = binary_search(t % filters(i) % real_bins, & + matching_bins(i) = binary_search(t % filters(i) % real_bins, & n + 1, E) end if @@ -1373,17 +1373,17 @@ contains ! check if energy of the particle is within energy bins if (p % E < t % filters(i) % real_bins(1) .or. & p % E > t % filters(i) % real_bins(n + 1)) then - t % matching_bins(i) = NO_BIN_FOUND + matching_bins(i) = NO_BIN_FOUND else ! search to find incoming energy bin - t % matching_bins(i) = binary_search(t % filters(i) % real_bins, & + matching_bins(i) = binary_search(t % filters(i) % real_bins, & n + 1, p % E) end if end select ! If the current filter didn't match, exit this subroutine - if (t % matching_bins(i) == NO_BIN_FOUND) then + if (matching_bins(i) == NO_BIN_FOUND) then found_bin = .false. return end if @@ -1475,7 +1475,7 @@ contains end if ! search to find incoming energy bin - t % matching_bins(j) = binary_search(t % filters(j) % real_bins, & + matching_bins(j) = binary_search(t % filters(j) % real_bins, & n + 1, p % E) end if @@ -1492,10 +1492,10 @@ contains do j = ijk0(3), ijk1(3) - 1 ijk0(3) = j if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - t % matching_bins(i_filter_surf) = OUT_TOP - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_surf) = OUT_TOP + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 !$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt @@ -1506,10 +1506,10 @@ contains do j = ijk0(3) - 1, ijk1(3), -1 ijk0(3) = j if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - t % matching_bins(i_filter_surf) = IN_TOP - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_surf) = IN_TOP + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 !$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt @@ -1524,10 +1524,10 @@ contains do j = ijk0(2), ijk1(2) - 1 ijk0(2) = j if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - t % matching_bins(i_filter_surf) = OUT_FRONT - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_surf) = OUT_FRONT + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 !$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt @@ -1538,10 +1538,10 @@ contains do j = ijk0(2) - 1, ijk1(2), -1 ijk0(2) = j if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - t % matching_bins(i_filter_surf) = IN_FRONT - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_surf) = IN_FRONT + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 !$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt @@ -1556,10 +1556,10 @@ contains do j = ijk0(1), ijk1(1) - 1 ijk0(1) = j if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - t % matching_bins(i_filter_surf) = OUT_RIGHT - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_surf) = OUT_RIGHT + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 !$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt @@ -1570,10 +1570,10 @@ contains do j = ijk0(1) - 1, ijk1(1), -1 ijk0(1) = j if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - t % matching_bins(i_filter_surf) = IN_RIGHT - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_surf) = IN_RIGHT + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 !$omp critical t % results(1, filter_index) % value = & t % results(1, filter_index) % value + p % wgt @@ -1598,7 +1598,7 @@ contains do k = 1, n_cross ! Reset scoring bin index - t % matching_bins(i_filter_surf) = 0 + matching_bins(i_filter_surf) = 0 ! Calculate distance to each bounding surface. We need to treat ! special case where the cosine of the angle is zero since this would @@ -1625,8 +1625,8 @@ contains ! Crossing into right mesh cell -- this is treated as outgoing ! current from (i,j,k) if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - t % matching_bins(i_filter_surf) = OUT_RIGHT - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_surf) = OUT_RIGHT + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) end if ijk0(1) = ijk0(1) + 1 @@ -1637,8 +1637,8 @@ contains ijk0(1) = ijk0(1) - 1 xyz_cross(1) = xyz_cross(1) - m % width(1) if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - t % matching_bins(i_filter_surf) = IN_RIGHT - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_surf) = IN_RIGHT + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) end if end if @@ -1647,8 +1647,8 @@ contains ! Crossing into front mesh cell -- this is treated as outgoing ! current in (i,j,k) if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - t % matching_bins(i_filter_surf) = OUT_FRONT - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_surf) = OUT_FRONT + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) end if ijk0(2) = ijk0(2) + 1 @@ -1659,8 +1659,8 @@ contains ijk0(2) = ijk0(2) - 1 xyz_cross(2) = xyz_cross(2) - m % width(2) if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - t % matching_bins(i_filter_surf) = IN_FRONT - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_surf) = IN_FRONT + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) end if end if @@ -1669,8 +1669,8 @@ contains ! Crossing into top mesh cell -- this is treated as outgoing ! current in (i,j,k) if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - t % matching_bins(i_filter_surf) = OUT_TOP - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_surf) = OUT_TOP + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) end if ijk0(3) = ijk0(3) + 1 @@ -1681,16 +1681,16 @@ contains ijk0(3) = ijk0(3) - 1 xyz_cross(3) = xyz_cross(3) - m % width(3) if (all(ijk0 >= 0) .and. all(ijk0 <= m % dimension)) then - t % matching_bins(i_filter_surf) = IN_TOP - t % matching_bins(i_filter_mesh) = & + matching_bins(i_filter_surf) = IN_TOP + matching_bins(i_filter_mesh) = & mesh_indices_to_bin(m, ijk0 + 1, .true.) end if end if end if ! Determine scoring index - if (t % matching_bins(i_filter_surf) > 0) then - filter_index = sum((t % matching_bins - 1) * t % stride) + 1 + if (matching_bins(i_filter_surf) > 0) then + filter_index = sum((matching_bins(1:t%n_filters) - 1) * t % stride) + 1 ! Check for errors if (filter_index <= 0 .or. filter_index > & diff --git a/src/tally_header.F90 b/src/tally_header.F90 index 41c5d79715..17cb1cb0de 100644 --- a/src/tally_header.F90 +++ b/src/tally_header.F90 @@ -86,7 +86,6 @@ module tally_header ! mapped onto one dimension in the results array, the stride attribute gives ! the stride for a given filter type within the results array - integer, allocatable :: matching_bins(:) integer, allocatable :: stride(:) ! This array provides a way to lookup what index in the filters array a @@ -169,8 +168,6 @@ module tally_header deallocate(this % filters) end if - if (allocated(this % matching_bins)) & - deallocate(this % matching_bins) if (allocated(this % stride)) & deallocate(this % stride) diff --git a/src/tally_initialize.F90 b/src/tally_initialize.F90 index 04928499e7..23ab5b5634 100644 --- a/src/tally_initialize.F90 +++ b/src/tally_initialize.F90 @@ -31,9 +31,10 @@ contains subroutine setup_tally_arrays() - integer :: i ! loop index for tallies - integer :: j ! loop index for filters - integer :: n ! temporary stride + integer :: i ! loop index for tallies + integer :: j ! loop index for filters + integer :: n ! temporary stride + integer :: max_n_filters = 0 ! maximum number of filters type(TallyObject), pointer :: t => null() TALLY_LOOP: do i = 1, n_tallies @@ -42,7 +43,7 @@ contains ! Allocate stride and matching_bins arrays allocate(t % stride(t % n_filters)) - allocate(t % matching_bins(t % n_filters)) + max_n_filters = max(max_n_filters, t % n_filters) ! The filters are traversed in opposite order so that the last filter has ! the shortest stride in memory and the first filter has the largest @@ -63,6 +64,11 @@ contains end do TALLY_LOOP + ! Allocate array for matching filter bins +!$omp parallel + allocate(matching_bins(max_n_filters)) +!$omp end parallel + end subroutine setup_tally_arrays !=============================================================================== From 68d5ad00a2ed6617ba97e1895b52c01fb2a7c758 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 18 Aug 2013 10:50:25 -0400 Subject: [PATCH 21/42] Make active tally lists threadprivate. --- src/eigenvalue.F90 | 2 ++ src/global.F90 | 2 ++ 2 files changed, 4 insertions(+) diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index f52ccef810..e46d5c996b 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -127,7 +127,9 @@ contains tallies_on = .true. ! Add user tallies to active tallies list +!$omp parallel call setup_active_usertallies() +!$omp end parallel end if ! check CMFD initialize batch diff --git a/src/global.F90 b/src/global.F90 index dd436fefc2..9466589b1b 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -112,6 +112,8 @@ module global type(SetInt) :: active_tracklength_tallies type(SetInt) :: active_current_tallies type(SetInt) :: active_tallies +!$omp threadprivate(active_analog_tallies, active_tracklength_tallies, & +!$omp& active_current_tallies, active_tallies) ! Global tallies ! 1) collision estimate of k-eff From 8f0f884eec7ea422fccf25a869fabdb42179dd15 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 18 Aug 2013 11:13:47 -0400 Subject: [PATCH 22/42] Added OpenMP threading for fixed source runs. --- src/fixed_source.F90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/fixed_source.F90 b/src/fixed_source.F90 index b057008728..cac08a1559 100644 --- a/src/fixed_source.F90 +++ b/src/fixed_source.F90 @@ -12,6 +12,7 @@ module fixed_source use tracking, only: transport type(Bank), pointer :: source_site => null() +!$omp threadprivate(source_site) contains @@ -23,11 +24,15 @@ contains if (master) call header("FIXED SOURCE TRANSPORT SIMULATION", level=1) ! Allocate particle and dummy source site +!$omp parallel allocate(source_site) +!$omp end parallel ! Turn timer and tallies on tallies_on = .true. +!$omp parallel call setup_active_usertallies() +!$omp end parallel call time_active % start() ! ========================================================================== @@ -47,6 +52,7 @@ contains ! ======================================================================= ! LOOP OVER PARTICLES +!$omp parallel do schedule(static) firstprivate(p) PARTICLE_LOOP: do i = 1, work ! Set unique particle ID @@ -67,6 +73,7 @@ contains call transport(p) end do PARTICLE_LOOP +!$omp end parallel do ! Accumulate time for transport call time_transport % stop() From a0ddce284e6fe8c6cbcab56c7114b5242156fdda Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 18 Aug 2013 12:50:34 -0400 Subject: [PATCH 23/42] Enclose global leakage tally in omp critical. --- src/geometry.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/geometry.F90 b/src/geometry.F90 index 547ad21d36..7e1bc283c1 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -408,8 +408,12 @@ contains end if ! Score to global leakage tally - if (tallies_on) global_tallies(LEAKAGE) % value = & + if (tallies_on) then +!$omp critical + global_tallies(LEAKAGE) % value = & global_tallies(LEAKAGE) % value + p % wgt +!$omp end critical + end if ! Display message if (verbosity >= 10 .or. trace) then From ad20baa03f2a4b2dbe5aed57cfa69054076fe8b3 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 18 Aug 2013 16:02:48 -0400 Subject: [PATCH 24/42] Add OPENMP Makefile variable to installation instructions. --- docs/source/usersguide/install.rst | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/docs/source/usersguide/install.rst b/docs/source/usersguide/install.rst index ef01aeff7f..ee7697de3e 100644 --- a/docs/source/usersguide/install.rst +++ b/docs/source/usersguide/install.rst @@ -135,6 +135,10 @@ MPI Enables parallel runs using the Message Passing Interface. The MPI_DIR variable should be set to the base directory of the MPI implementation. +OPENMP + Enables shared-memory parallelism using the OpenMP API. The Fortran compiler + being used must support OpenMP. + HDF5 Enables HDF5 output in addition to normal screen and text file output. The HDF5_DIR variable should be set to the base directory of the HDF5 From dc096bda0f0aaf4d36aae50c7dcc0152b1c9b8cf Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 23 Aug 2013 12:31:37 -0400 Subject: [PATCH 25/42] Make sure thread fission banks are deallocated. --- src/global.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/global.F90 b/src/global.F90 index b8a0b4bcfd..1530f13a09 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -446,13 +446,19 @@ contains ! Now deallocate the tally array deallocate(tallies) end if + if (allocated(matching_bins)) deallocate(matching_bins) if (allocated(tally_maps)) deallocate(tally_maps) ! Deallocate energy grid if (allocated(e_grid)) deallocate(e_grid) ! Deallocate fission and source bank and entropy +!$omp parallel if (allocated(fission_bank)) deallocate(fission_bank) +!$omp end parallel +#ifdef OPENMP + if (allocated(master_fission_bank)) deallocate(master_fission_bank) +#endif if (allocated(source_bank)) deallocate(source_bank) if (allocated(entropy_p)) deallocate(entropy_p) From b7e4fd6d8416184ff398974983ce96ff6320e221 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Wed, 28 Aug 2013 01:05:43 -0400 Subject: [PATCH 26/42] Change last instance of omp atomic to omp critical. --- src/geometry.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/geometry.F90 b/src/geometry.F90 index 7e1bc283c1..0e6700d851 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -1572,8 +1572,9 @@ contains ! Increment number of lost particles p % alive = .false. -!$omp atomic +!$omp critical n_lost_particles = n_lost_particles + 1 +!$omp end critical ! Abort the simulation if the maximum number of lost particles has been ! reached From f6766c169d1a7e133bd244ee6ac8ea44680b8d54 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 1 Sep 2013 23:45:38 -0400 Subject: [PATCH 27/42] Add option to set number of threads in settings.xml and command line. --- src/global.F90 | 2 +- src/initialize.F90 | 17 +++++++++++++++++ src/input_xml.F90 | 18 ++++++++++++++++++ src/output.F90 | 1 + src/templates/settings.rnc | 2 ++ src/templates/settings_t.xml | 1 + 6 files changed, 40 insertions(+), 1 deletion(-) diff --git a/src/global.F90 b/src/global.F90 index 1530f13a09..f96f59cf08 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -212,7 +212,7 @@ module global integer :: MPI_TALLYRESULT ! MPI datatype for TallyResult #ifdef OPENMP - integer :: n_threads ! number of OpenMP threads + integer :: n_threads = NONE ! number of OpenMP threads integer :: thread_id ! ID of a given thread #endif diff --git a/src/initialize.F90 b/src/initialize.F90 index d82b1a7276..da2ace4d09 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -367,6 +367,23 @@ contains case ('-g', '-geometry-debug', '--geometry-debug') check_overlaps = .true. + case ('-t', '--threads') + ! Read number of threads + i = i + 1 + +#ifdef OPENMP + ! Read and set number of OpenMP threads + n_threads = str_to_int(argv(i)) + if (n_threads < 1) then + message = "Invalid number of threads specified on command line." + call fatal_error() + end if + call omp_set_num_threads(n_threads) +#else + message = "Ignoring number of threads specified on command line." + call warning() +#endif + case ('-?', '-help', '--help') call print_usage() stop diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 617788e472..c2d1a86d16 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -73,6 +73,7 @@ contains cross_sections_ = '' output_path_ = '' verbosity_ = 0 + threads_ = NONE energy_grid_ = 'union' seed_ = 0_8 source_ % file = '' @@ -207,6 +208,23 @@ contains ! Verbosity if (verbosity_ > 0) verbosity = verbosity_ + ! Number of OpenMP threads + if (threads_ /= NONE) then +#ifdef OPENMP + if (n_threads == NONE) then + n_threads = threads_ + if (n_threads < 1) then + message = "Invalid number of threads: " // to_str(n_threads) + call fatal_error() + end if + call omp_set_num_threads(n_threads) + end if +#else + message = "Ignoring number of threads." + call warning() +#endif + end if + ! ========================================================================== ! EXTERNAL SOURCE diff --git a/src/output.F90 b/src/output.F90 index 472cb5574b..ffffb745c5 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -170,6 +170,7 @@ contains write(OUTPUT_UNIT,*) ' -p, --plot Run in plotting mode' write(OUTPUT_UNIT,*) ' -r, --restart Restart a previous run from a state point' write(OUTPUT_UNIT,*) ' or a particle restart file' + write(OUTPUT_UNIT,*) ' -t, --threads Number of OpenMP threads' write(OUTPUT_UNIT,*) ' -v, --version Show version information' write(OUTPUT_UNIT,*) ' -?, --help Show this message' end if diff --git a/src/templates/settings.rnc b/src/templates/settings.rnc index 47dd690bcc..cd4ed4beb9 100644 --- a/src/templates/settings.rnc +++ b/src/templates/settings.rnc @@ -97,6 +97,8 @@ element settings { element survival_biasing { xsd:boolean }? & + element threads { xsd:positiveInteger }? & + element trace { list { xsd:positiveInteger+ } }? & element verbosity { xsd:positiveInteger }? & diff --git a/src/templates/settings_t.xml b/src/templates/settings_t.xml index 3afa61745e..8f1cc7b00c 100644 --- a/src/templates/settings_t.xml +++ b/src/templates/settings_t.xml @@ -58,6 +58,7 @@ + From 82c4568a6aab3e4408f634ed42176ae217762906 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Mon, 2 Sep 2013 00:44:34 -0400 Subject: [PATCH 28/42] Improved distribution of work among processes. --- src/cmfd_execute.F90 | 8 ++------ src/eigenvalue.F90 | 15 +++++++-------- src/fixed_source.F90 | 4 ++-- src/global.F90 | 7 ++++--- src/initialize.F90 | 40 +++++++++++++++++++++++++++++++--------- src/output_interface.F90 | 8 ++++---- src/source.F90 | 4 ++-- 7 files changed, 52 insertions(+), 34 deletions(-) diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index 7588d11a52..82630864fe 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -281,8 +281,7 @@ contains use constants, only: ZERO, ONE use error, only: warning, fatal_error use global, only: n_particles, meshes, source_bank, work, & - n_user_meshes, message, cmfd, master, mpi_err, & - bank_first, bank_last + n_user_meshes, message, cmfd, master, mpi_err use mesh_header, only: StructuredMesh use mesh, only: count_bank_sites, get_mesh_indices use search, only: binary_search @@ -312,9 +311,6 @@ contains nz = cmfd%indices(3) ng = cmfd%indices(4) - ! compute size of source bank - size_bank = bank_last - bank_first + 1_8 - ! allocate arrays in cmfd object (can take out later extend to multigroup) if (.not.allocated(cmfd%sourcecounts)) then allocate(cmfd%sourcecounts(ng,nx,ny,nz)) @@ -337,7 +333,7 @@ contains ! count bank sites in mesh call count_bank_sites(m, source_bank, cmfd%sourcecounts, egrid, & - sites_outside=outside, size_bank = size_bank) + sites_outside=outside, size_bank=work) ! check for sites outside of the mesh if (master .and. outside) then diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index 8c03ebffb9..a937aa336a 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -378,7 +378,7 @@ contains end if ! the last processor should not be sending sites to right - finish = bank_last + finish = work_index(rank + 1) end if call time_bank_sample % stop() @@ -394,11 +394,11 @@ contains if (start < n_particles) then ! Determine the index of the processor which has the first part of the ! source_bank for the local processor - neighbor = start / maxwork + neighbor = binary_search(work_index, n_procs + 1, start) - 1 SEND_SITES: do while (start < finish) ! Determine the number of sites to send - n = min((neighbor + 1)*maxwork, finish) - start + n = min(work_index(neighbor + 1), finish) - start ! Initiate an asynchronous send of source sites to the neighboring ! process @@ -423,7 +423,7 @@ contains ! ========================================================================== ! RECEIVE BANK SITES FROM NEIGHBORS OR TEMPORARY BANK - start = bank_first - 1 + start = work_index(rank) index_local = 1 ! Determine what process has the source sites that will need to be stored at @@ -435,13 +435,12 @@ contains neighbor = binary_search(bank_position, n_procs, start) - 1 end if - RECV_SITES: do while (start < bank_last) + RECV_SITES: do while (start < work_index(rank + 1)) ! Determine how many sites need to be received if (neighbor == n_procs - 1) then - n = min(n_particles, (rank+1)*maxwork) - start + n = work_index(rank + 1) - start else - n = min(bank_position(neighbor+2), min(n_particles, & - (rank+1)*maxwork)) - start + n = min(bank_position(neighbor + 2), work_index(rank + 1)) - start end if if (neighbor /= rank) then diff --git a/src/fixed_source.F90 b/src/fixed_source.F90 index b057008728..3fc95f05ac 100644 --- a/src/fixed_source.F90 +++ b/src/fixed_source.F90 @@ -50,12 +50,12 @@ contains PARTICLE_LOOP: do i = 1, work ! Set unique particle ID - p % id = (current_batch - 1)*n_particles + bank_first + i - 1 + p % id = (current_batch - 1)*n_particles + work_index(rank) + i ! set particle trace trace = .false. if (current_batch == trace_batch .and. current_gen == trace_gen .and. & - bank_first + i - 1 == trace_particle) trace = .true. + work_index(rank) + i == trace_particle) trace = .true. ! set random number seed call set_particle_seed(p % id) diff --git a/src/global.F90 b/src/global.F90 index 362a308b2a..d1441213fb 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -160,10 +160,8 @@ module global type(Bank), allocatable, target :: source_bank(:) type(Bank), allocatable, target :: fission_bank(:) integer(8) :: n_bank ! # of sites in fission bank - integer(8) :: bank_first ! index of first particle in bank - integer(8) :: bank_last ! index of last particle in bank integer(8) :: work ! number of particles per processor - integer(8) :: maxwork ! maximum number of particles per processor + integer(8), allocatable :: work_index(:) ! starting index in source bank for each process integer(8) :: current_work ! index in source bank of current history simulated ! Temporary k-effective values @@ -442,6 +440,9 @@ contains if (allocated(source_bank)) deallocate(source_bank) if (allocated(entropy_p)) deallocate(entropy_p) + ! Deallocate array of work indices + if (allocated(work_index)) deallocate(work_index) + ! Deallocate cmfd call deallocate_cmfd(cmfd) diff --git a/src/initialize.F90 b/src/initialize.F90 index 033917dc11..24404396bd 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -754,15 +754,37 @@ contains subroutine calculate_work() - ! Determine maximum amount of particles to simulate on each processor - maxwork = ceiling(real(n_particles)/n_procs,8) + integer :: i ! loop index + integer :: remainder ! Number of processors with one extra particle + integer(8) :: i_bank ! Running count of number of particles + integer(8) :: min_work ! Minimum number of particles on each proc + integer(8) :: work_i ! Number of particles on rank i - ! ID's of first and last source particles - bank_first = rank*maxwork + 1 - bank_last = min((rank+1)*maxwork, n_particles) + allocate(work_index(0:n_procs)) - ! number of particles for this processor - work = bank_last - bank_first + 1 + ! Determine minimum amount of particles to simulate on each processor + min_work = n_particles/n_procs + + ! Determine number of processors that have one extra particle + remainder = int(mod(n_particles, int(n_procs,8)), 4) + + i_bank = 0 + work_index(0) = 0 + do i = 0, n_procs - 1 + ! Number of particles for rank i + if (i < remainder) then + work_i = min_work + 1 + else + work_i = min_work + end if + + ! Set number of particles + if (rank == i) work = work_i + + ! Set index into source bank for rank i + i_bank = i_bank + work_i + work_index(i+1) = i_bank + end do end subroutine calculate_work @@ -775,7 +797,7 @@ contains integer :: alloc_err ! allocation error code ! Allocate source bank - allocate(source_bank(maxwork), STAT=alloc_err) + allocate(source_bank(work), STAT=alloc_err) ! Check for allocation errors if (alloc_err /= 0) then @@ -784,7 +806,7 @@ contains end if ! Allocate fission bank - allocate(fission_bank(3*maxwork), STAT=alloc_err) + allocate(fission_bank(3*work), STAT=alloc_err) ! Check for allocation errors if (alloc_err /= 0) then diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 5f421a6d25..2abcbe9c69 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -947,7 +947,7 @@ contains call h5dget_space_f(dset, dspace, hdf5_err) ! Select hyperslab for this dataspace - offset(1) = bank_first - 1_8 + offset(1) = work_index(rank) call h5sselect_hyperslab_f(dspace, H5S_SELECT_SET_F, offset, dims1, hdf5_err) ! Set up the property list for parallel writing @@ -1009,7 +1009,7 @@ contains ! 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 + offset = offset + size_bank*work_index(rank) ! Write all source sites call MPI_FILE_WRITE_AT(mpi_fh, offset, source_bank(1), work, MPI_BANK, & @@ -1056,7 +1056,7 @@ contains call h5dget_space_f(dset, dspace, hdf5_err) ! Select hyperslab for this dataspace - offset(1) = bank_first - 1_8 + offset(1) = work_index(rank) call h5sselect_hyperslab_f(dspace, H5S_SELECT_SET_F, offset, dims1, hdf5_err) ! Set up the property list for parallel writing @@ -1109,7 +1109,7 @@ contains ! 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 + offset = offset + size_bank*work_index(rank) ! Write all source sites call MPI_FILE_READ_AT(mpi_fh, offset, source_bank(1), work, MPI_BANK, & diff --git a/src/source.F90 b/src/source.F90 index c951c11ffa..0aedecda3b 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -47,7 +47,7 @@ contains src => source_bank(i) ! initialize random number seed - id = bank_first + i - 1 + id = work_index(rank) + i call set_particle_seed(id) ! sample external source distribution @@ -165,7 +165,7 @@ contains call copy_source_attributes(p, src) ! set identifier for particle - p % id = bank_first + index_source - 1 + p % id = work_index(rank) + index_source ! set random number seed particle_seed = (overall_gen - 1)*n_particles + p % id From 92404609851a608493fc90f78137bfaf622e95cb Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 4 Sep 2013 08:26:00 -0400 Subject: [PATCH 29/42] removed size bank and use work as the bank size --- src/cmfd_execute.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/cmfd_execute.F90 b/src/cmfd_execute.F90 index 82630864fe..44e94a2aa6 100644 --- a/src/cmfd_execute.F90 +++ b/src/cmfd_execute.F90 @@ -295,7 +295,6 @@ contains integer :: ijk(3) ! spatial bin location integer :: e_bin ! energy bin of source particle integer :: n_groups ! number of energy groups - integer(8) :: size_bank ! size of source bank logical :: outside ! any source sites outside mesh logical :: in_mesh ! source site is inside mesh logical :: new_weights ! calcualte new weights @@ -356,7 +355,7 @@ contains end if ! begin loop over source bank - do i = 1, int(size_bank, 4) + do i = 1, int(work,4) ! determine spatial bin call get_mesh_indices(m, source_bank(i)%xyz, ijk, in_mesh) From b8ed9868ea10e45d3c22d8ea3ac65e187e123b55 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 4 Sep 2013 11:40:13 -0400 Subject: [PATCH 30/42] 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 31/42] 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 32/42] 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 33/42] 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) From 975fd21284f3c950d1015d8cd6517894b2894f2f Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 7 Sep 2013 15:02:46 -0400 Subject: [PATCH 34/42] Allow test suite to be run with compiler other than gfortran. --- tests/run_tests.py | 21 +++++----- tests/test_compile/test_compile.py | 65 ++++++++++++++++-------------- 2 files changed, 47 insertions(+), 39 deletions(-) diff --git a/tests/run_tests.py b/tests/run_tests.py index 2b816a2285..5e261fba73 100755 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -55,7 +55,11 @@ def run_suite(name=None, mpi=False): results.append((name, result)) # set mpiexec path -mpiexec = '/opt/mpich/3.0.4-gnu/bin/mpiexec' +if os.environ.has_key('COMPILER'): + compiler = os.environ['COMPILER'] +else: + compiler = 'gnu' +mpiexec = '/opt/mpich/3.0.4-{0}/bin/mpiexec'.format(compiler) # get current working directory pwd = os.getcwd() @@ -63,23 +67,22 @@ sys.path.append(pwd) # Set list of tests, either default or from command line flags = [] -tests = ['compile', 'gfortran', 'gfortran-dbg', 'gfortran-opt', - 'gfortran-hdf5', 'gfortran-mpi', 'gfortran-phdf5', - 'gfortran-petsc', 'gfortran-phdf5-petsc', - 'gfortran-phdf5-petsc-opt'] +tests = ['compile', 'normal', 'debug', 'optimize', 'hdf5', 'mpi', 'phdf5', + 'petsc', 'phdf5-petsc', 'phdf5-petsc-optimize'] if len(sys.argv) > 1: flags = [i for i in sys.argv[1:] if i.startswith('-')] - tests = [i for i in sys.argv[1:] if not i.startswith('-')] + tests_ = [i for i in sys.argv[1:] if not i.startswith('-')] + tests = tests_ if tests_ else tests # Run tests results = [] for name in tests: if name == 'compile': run_compile() - elif name in ['gfortran', 'gfortran-dbg', 'gfortran-opt', 'gfortran-hdf5']: + elif name in ['normal', 'debug', 'optimize', 'hdf5']: run_suite(name=name) - elif name in ['gfortran-mpi', 'gfortran-phdf5', 'gfortran-petsc', - 'gfortran-phdf5-petsc', 'gfortran-phdf5-petsc-opt']: + elif name in ['mpi', 'phdf5', 'petsc', 'phdf5-petsc', + 'phdf5-petsc-optimize']: run_suite(name=name, mpi=True) # print out summary of results diff --git a/tests/test_compile/test_compile.py b/tests/test_compile/test_compile.py index dbbeaa5337..72e4dd6535 100644 --- a/tests/test_compile/test_compile.py +++ b/tests/test_compile/test_compile.py @@ -15,68 +15,73 @@ import shutil pwd = os.path.dirname(__file__) +if os.environ.has_key('COMPILER'): + compiler = 'COMPILER=' + os.environ['COMPILER'] +else: + compiler = 'COMPILER=gnu' + def setup(): # Change to source directory os.chdir(pwd + '/../../src') -def test_gfortran(): +def test_normal(): returncode = run(['make','distclean']) - returncode = run(['make']) + returncode = run(['make', compiler]) assert returncode == 0 - shutil.move('openmc', 'openmc-gfortran') + shutil.move('openmc', 'openmc-normal') -def test_gfortran_debug(): +def test_debug(): returncode = run(['make','distclean']) - returncode = run(['make', 'DEBUG=yes']) + returncode = run(['make', compiler, 'DEBUG=yes']) assert returncode == 0 - shutil.move('openmc', 'openmc-gfortran-dbg') + shutil.move('openmc', 'openmc-debug') -def test_gfortran_profile(): +def test_profile(): returncode = run(['make','distclean']) - returncode = run(['make', 'PROFILE=yes']) + returncode = run(['make', compiler, 'PROFILE=yes']) assert returncode == 0 -def test_gfortran_optimize(): +def test_optimize(): returncode = run(['make','distclean']) - returncode = run(['make', 'OPTIMIZE=yes']) + returncode = run(['make', compiler, 'OPTIMIZE=yes']) assert returncode == 0 - shutil.move('openmc', 'openmc-gfortran-opt') + shutil.move('openmc', 'openmc-optimize') -def test_gfortran_mpi(): +def test_mpi(): returncode = run(['make','distclean']) - returncode = run(['make', 'MPI=yes']) + returncode = run(['make', compiler, 'MPI=yes']) assert returncode == 0 - shutil.move('openmc', 'openmc-gfortran-mpi') + shutil.move('openmc', 'openmc-mpi') -def test_gfortran_hdf5(): +def test_hdf5(): returncode = run(['make','distclean']) - returncode = run(['make', 'HDF5=yes']) + returncode = run(['make', compiler, 'HDF5=yes']) assert returncode == 0 - shutil.move('openmc', 'openmc-gfortran-hdf5') + shutil.move('openmc', 'openmc-hdf5') -def test_gfortran_petsc(): +def test_petsc(): returncode = run(['make','distclean']) - returncode = run(['make', 'MPI=yes', 'PETSC=yes']) + returncode = run(['make', compiler, 'MPI=yes', 'PETSC=yes']) assert returncode == 0 - shutil.move('openmc', 'openmc-gfortran-petsc') + shutil.move('openmc', 'openmc-petsc') -def test_gfortran_mpi_hdf5(): +def test_mpi_hdf5(): returncode = run(['make','distclean']) - returncode = run(['make', 'MPI=yes', 'HDF5=yes']) + returncode = run(['make', compiler, 'MPI=yes', 'HDF5=yes']) assert returncode == 0 - shutil.move('openmc', 'openmc-gfortran-phdf5') + shutil.move('openmc', 'openmc-phdf5') -def test_gfortran_mpi_hdf5_petsc(): +def test_mpi_hdf5_petsc(): returncode = run(['make','distclean']) - returncode = run(['make', 'MPI=yes', 'HDF5=yes', 'PETSC=yes']) + returncode = run(['make', compiler, 'MPI=yes', 'HDF5=yes', 'PETSC=yes']) assert returncode == 0 - shutil.move('openmc', 'openmc-gfortran-phdf5-petsc') + shutil.move('openmc', 'openmc-phdf5-petsc') -def test_gfortran_mpi_hdf5_petsc_optimize(): +def test_mpi_hdf5_petsc_optimize(): returncode = run(['make','distclean']) - returncode = run(['make', 'MPI=yes', 'HDF5=yes', 'PETSC=yes', 'OPTIMIZE=yes']) + returncode = run(['make', compiler, 'MPI=yes', 'HDF5=yes', 'PETSC=yes', 'OPTIMIZE=yes']) assert returncode == 0 - shutil.move('openmc', 'openmc-gfortran-phdf5-petsc-opt') + shutil.move('openmc', 'openmc-phdf5-petsc-optimize') def run(commands): proc = Popen(commands, stderr=STDOUT, stdout=PIPE) @@ -86,4 +91,4 @@ def run(commands): def teardown(commands): returncode = run(['make','distclean']) - shutil.copy('openmc-gfortran','openmc') + shutil.copy('openmc-normal','openmc') From 7e5e146f4ebd0cb5c58b05f2d895ef83633725a1 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 7 Sep 2013 19:10:52 -0400 Subject: [PATCH 35/42] Change command-line options. --- src/initialize.F90 | 4 ++-- src/output.F90 | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/initialize.F90 b/src/initialize.F90 index 8307c1e3d1..dea901fb66 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -335,7 +335,7 @@ contains run_mode = MODE_PLOTTING check_overlaps = .true. - case ('-n', '-n_particles', '--n_particles') + case ('-n', '-particles', '--particles') ! Read number of particles per cycle i = i + 1 n_particles = str_to_int(argv(i)) @@ -368,7 +368,7 @@ contains case ('-g', '-geometry-debug', '--geometry-debug') check_overlaps = .true. - case ('-t', '--threads') + case ('-s', '--threads') ! Read number of threads i = i + 1 diff --git a/src/output.F90 b/src/output.F90 index ffffb745c5..8b54dc54a9 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -167,10 +167,11 @@ contains write(OUTPUT_UNIT,*) write(OUTPUT_UNIT,*) 'Options:' write(OUTPUT_UNIT,*) ' -g, --geometry-debug Run in geometry debugging mode' + write(OUTPUT_UNIT,*) ' -n, --particles Number of particles per generation' write(OUTPUT_UNIT,*) ' -p, --plot Run in plotting mode' write(OUTPUT_UNIT,*) ' -r, --restart Restart a previous run from a state point' write(OUTPUT_UNIT,*) ' or a particle restart file' - write(OUTPUT_UNIT,*) ' -t, --threads Number of OpenMP threads' + write(OUTPUT_UNIT,*) ' -s, --threads Number of OpenMP threads' write(OUTPUT_UNIT,*) ' -v, --version Show version information' write(OUTPUT_UNIT,*) ' -?, --help Show this message' end if From d44dfd20d9c77be545e3560fa3f05e949d860db6 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 7 Sep 2013 20:29:18 -0400 Subject: [PATCH 36/42] Add OpenMP tests (also fix PEP8 compliance in test_compile.py). --- tests/run_tests.py | 13 +++--- tests/test_compile/test_compile.py | 75 +++++++++++++++++++++++------- 2 files changed, 66 insertions(+), 22 deletions(-) diff --git a/tests/run_tests.py b/tests/run_tests.py index 5e261fba73..1a1a05e839 100755 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -55,7 +55,7 @@ def run_suite(name=None, mpi=False): results.append((name, result)) # set mpiexec path -if os.environ.has_key('COMPILER'): +if 'COMPILER' in os.environ: compiler = os.environ['COMPILER'] else: compiler = 'gnu' @@ -67,8 +67,9 @@ sys.path.append(pwd) # Set list of tests, either default or from command line flags = [] -tests = ['compile', 'normal', 'debug', 'optimize', 'hdf5', 'mpi', 'phdf5', - 'petsc', 'phdf5-petsc', 'phdf5-petsc-optimize'] +tests = ['compile', 'normal', 'debug', 'optimize', 'mpi', 'omp', 'hdf5', + 'petsc', 'mpi-omp', 'omp-hdf5', 'phdf5', 'phdf5-petsc', + 'phdf5-petsc-optimize', 'omp-phdf5-petsc-optimize'] if len(sys.argv) > 1: flags = [i for i in sys.argv[1:] if i.startswith('-')] tests_ = [i for i in sys.argv[1:] if not i.startswith('-')] @@ -79,10 +80,10 @@ results = [] for name in tests: if name == 'compile': run_compile() - elif name in ['normal', 'debug', 'optimize', 'hdf5']: + elif name in ['normal', 'debug', 'optimize', 'omp', 'hdf5', 'omp-hdf5']: run_suite(name=name) - elif name in ['mpi', 'phdf5', 'petsc', 'phdf5-petsc', - 'phdf5-petsc-optimize']: + elif name in ['mpi', 'mpi-omp' 'phdf5', 'petsc', 'phdf5-petsc', + 'phdf5-petsc-optimize', 'omp-phdf5-petsc-optimize']: run_suite(name=name, mpi=True) # print out summary of results diff --git a/tests/test_compile/test_compile.py b/tests/test_compile/test_compile.py index 72e4dd6535..66368c08ad 100644 --- a/tests/test_compile/test_compile.py +++ b/tests/test_compile/test_compile.py @@ -3,8 +3,8 @@ """Compilation tests This set of tests makes sure that OpenMC can compile for many different -combinations of compilation flags and options. By default, only the gfortran and -ifort compilers are tested. This requires that the MPI, HDF5, and PETSC +combinations of compilation flags and options. By default, only the gfortran +and ifort compilers are tested. This requires that the MPI, HDF5, and PETSC libraries are already set up appropriately in the Makefile. """ @@ -15,80 +15,123 @@ import shutil pwd = os.path.dirname(__file__) -if os.environ.has_key('COMPILER'): +if 'COMPILER' in os.environ: compiler = 'COMPILER=' + os.environ['COMPILER'] else: compiler = 'COMPILER=gnu' + def setup(): # Change to source directory os.chdir(pwd + '/../../src') + def test_normal(): - returncode = run(['make','distclean']) + returncode = run(['make', 'distclean']) returncode = run(['make', compiler]) assert returncode == 0 shutil.move('openmc', 'openmc-normal') + def test_debug(): - returncode = run(['make','distclean']) + returncode = run(['make', 'distclean']) returncode = run(['make', compiler, 'DEBUG=yes']) assert returncode == 0 shutil.move('openmc', 'openmc-debug') + def test_profile(): - returncode = run(['make','distclean']) + returncode = run(['make', 'distclean']) returncode = run(['make', compiler, 'PROFILE=yes']) assert returncode == 0 + def test_optimize(): - returncode = run(['make','distclean']) + returncode = run(['make', 'distclean']) returncode = run(['make', compiler, 'OPTIMIZE=yes']) assert returncode == 0 shutil.move('openmc', 'openmc-optimize') + def test_mpi(): - returncode = run(['make','distclean']) + returncode = run(['make', 'distclean']) returncode = run(['make', compiler, 'MPI=yes']) assert returncode == 0 shutil.move('openmc', 'openmc-mpi') + +def test_omp(): + returncode = run(['make', 'distclean']) + returncode = run(['make', compiler, 'OPENMP=yes']) + assert returncode == 0 + shutil.move('openmc', 'openmc-omp') + + def test_hdf5(): - returncode = run(['make','distclean']) + returncode = run(['make', 'distclean']) returncode = run(['make', compiler, 'HDF5=yes']) assert returncode == 0 shutil.move('openmc', 'openmc-hdf5') + def test_petsc(): - returncode = run(['make','distclean']) + returncode = run(['make', 'distclean']) returncode = run(['make', compiler, 'MPI=yes', 'PETSC=yes']) assert returncode == 0 shutil.move('openmc', 'openmc-petsc') + +def test_mpi_omp(): + returncode = run(['make', 'distclean']) + returncode = run(['make', compiler, 'MPI=yes', 'OPENMP=yes']) + assert returncode == 0 + shutil.move('openmc', 'openmc-mpi-omp') + + +def test_omp_hdf5(): + returncode = run(['make', 'distclean']) + returncode = run(['make', compiler, 'MPI=yes', 'OPENMP=yes', 'HDF5=yes']) + assert returncode == 0 + shutil.move('openmc', 'openmc-omp-hdf5') + + def test_mpi_hdf5(): - returncode = run(['make','distclean']) + returncode = run(['make', 'distclean']) returncode = run(['make', compiler, 'MPI=yes', 'HDF5=yes']) assert returncode == 0 shutil.move('openmc', 'openmc-phdf5') + def test_mpi_hdf5_petsc(): - returncode = run(['make','distclean']) + returncode = run(['make', 'distclean']) returncode = run(['make', compiler, 'MPI=yes', 'HDF5=yes', 'PETSC=yes']) assert returncode == 0 shutil.move('openmc', 'openmc-phdf5-petsc') + def test_mpi_hdf5_petsc_optimize(): - returncode = run(['make','distclean']) - returncode = run(['make', compiler, 'MPI=yes', 'HDF5=yes', 'PETSC=yes', 'OPTIMIZE=yes']) + returncode = run(['make', 'distclean']) + returncode = run(['make', compiler, 'MPI=yes', 'HDF5=yes', 'PETSC=yes', + 'OPTIMIZE=yes']) assert returncode == 0 shutil.move('openmc', 'openmc-phdf5-petsc-optimize') + +def test_mpi_omp_hdf5_petsc_optimize(): + returncode = run(['make', 'distclean']) + returncode = run(['make', compiler, 'MPI=yes', 'OMP=yes', 'HDF5=yes', + 'PETSC=yes', 'OPTIMIZE=yes']) + assert returncode == 0 + shutil.move('openmc', 'openmc-omp-phdf5-petsc-optimize') + + def run(commands): proc = Popen(commands, stderr=STDOUT, stdout=PIPE) returncode = proc.wait() print(proc.communicate()[0]) return returncode + def teardown(commands): - returncode = run(['make','distclean']) - shutil.copy('openmc-normal','openmc') + returncode = run(['make', 'distclean']) + shutil.copy('openmc-normal', 'openmc') From 911e3d163eb7c4d340d8c0b73349c20043e8017a Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 8 Sep 2013 10:58:22 -0400 Subject: [PATCH 37/42] Started 0.5.3 release notes. --- docs/source/releasenotes/notes_0.5.3.rst | 45 ++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 docs/source/releasenotes/notes_0.5.3.rst diff --git a/docs/source/releasenotes/notes_0.5.3.rst b/docs/source/releasenotes/notes_0.5.3.rst new file mode 100644 index 0000000000..fb7b1aa79a --- /dev/null +++ b/docs/source/releasenotes/notes_0.5.3.rst @@ -0,0 +1,45 @@ +.. _notes_0.5.3: + +============================== +Release Notes for OpenMC 0.5.3 +============================== + +.. note:: + These release notes are for an upcoming release of OpenMC and are still + subject to change. + +------------------- +System Requirements +------------------- + +There are no special requirements for running the OpenMC code. As of this +release, OpenMC has been tested on a variety of Linux distributions, Mac OS X, +and Microsoft Windows 7. Memory requirements will vary depending on the size of +the problem at hand (mostly on the number of nuclides in the problem). + +------------ +New Features +------------ + +- Special run mode --tallies removed. +- Particle restarts and state point restarts are both identified with the -r + command line flag. +- New regression test suite. +- All memory leaks fixed. +- Shared-memory parallelism with OpenMP. + +--------- +Bug Fixes +--------- + +- 2b1e8a_: Normalize direction vector after reflecting particle. +- 5853d2_: Set blank default for cross section listing alias. +- e178c7_: Fix infinite loop with words greater than 80 characters in write_message. +- c18a6e_: Chcek for valid secondary mode on S(a,b) tables. +- 82c456_: Fix bug where last process could have zero particles. + +.. _2b1e8a: https://github.com/mit-crpg/openmc/commit/2b1e8a +.. _5853d2: https://github.com/mit-crpg/openmc/commit/5853d2 +.. _e178c7: https://github.com/mit-crpg/openmc/commit/e178c7 +.. _c18a6e: https://github.com/mit-crpg/openmc/commit/c18a6e +.. _82c456: https://github.com/mit-crpg/openmc/commit/82c456 From 71bfed38fb12fe9f5b8fab7ced55a20bf0441666 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Tue, 10 Sep 2013 22:34:22 -0400 Subject: [PATCH 38/42] Add description of element in user's guide. --- docs/source/usersguide/input.rst | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index d9b43c8214..3ce8934108 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -381,6 +381,14 @@ survival biasing, otherwise known as implicit capture or absorption. .. _trace: +```` Element +--------------------- + +The ```` element indicates the number of OpenMP threads to be used for +a simulation. It has no attributes and accept a positive integer value. + + *Default*: None (Determined by environment variable :envvar:`OMP_NUM_THREADS`) + ```` Element ------------------- From 45fb774d6d6ff1dec3a7683fb86814e862400b52 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Tue, 10 Sep 2013 22:56:46 -0400 Subject: [PATCH 39/42] Mention command-line flags in user's guide. --- docs/source/usersguide/install.rst | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/docs/source/usersguide/install.rst b/docs/source/usersguide/install.rst index d855aca499..159c689e98 100644 --- a/docs/source/usersguide/install.rst +++ b/docs/source/usersguide/install.rst @@ -330,6 +330,20 @@ Alternatively, you could run from any directory: Note that in the latter case, any output files will be placed in the present working directory which may be different from ``/home/username/somemodel``. +Command-Line Flags +------------------ + +OpenMC accepts the following command line flags: + +-g, --geometry-debug Run in geometry debugging mode, where cell overlaps are + checked for after each move of a particle +-n, --particles N Use *N* particles per generation or batch +-p, --plot Run in plotting mode +-r, --restart file Restart a previous run from a state point or a particle + restart file +-s, --threads N Run with *N* OpenMP threads +-v, --version Show version information + ----------------------------------------------------- Configuring Input Validation with GNU Emacs nXML mode ----------------------------------------------------- From 68f636294e98402d41bdcbcea0a4850867f67147 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Tue, 10 Sep 2013 22:58:28 -0400 Subject: [PATCH 40/42] Update man page with -s, --threads option. --- man/man1/openmc.1 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/man1/openmc.1 b/man/man1/openmc.1 index 1614e48751..fb0fdd7177 100644 --- a/man/man1/openmc.1 +++ b/man/man1/openmc.1 @@ -24,6 +24,9 @@ Run in plotting mode Restart a previous run from a state point or a particle restart file named \fIbinaryFile\fP. .TP +.BI \-s " N" "\fR,\fP \-\-threads" " N" +Use \fIN\fP OpenMP threads. +.TP .B "\-v\fR, \fP\-\-version" Show version information. .TP From 8aa03c1cbd0fdb6fbbc5230035175e269189cd11 Mon Sep 17 00:00:00 2001 From: Adam Nelson Date: Wed, 11 Sep 2013 10:35:07 -0400 Subject: [PATCH 41/42] Fixed a typo in addition to docs entry. --- docs/source/usersguide/input.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/source/usersguide/input.rst b/docs/source/usersguide/input.rst index 3ce8934108..425df5029a 100644 --- a/docs/source/usersguide/input.rst +++ b/docs/source/usersguide/input.rst @@ -385,7 +385,7 @@ survival biasing, otherwise known as implicit capture or absorption. --------------------- The ```` element indicates the number of OpenMP threads to be used for -a simulation. It has no attributes and accept a positive integer value. +a simulation. It has no attributes and accepts a positive integer value. *Default*: None (Determined by environment variable :envvar:`OMP_NUM_THREADS`) From 41350dc42283f6ba414363dbeae52f198cdcab49 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 21 Sep 2013 17:15:54 -0400 Subject: [PATCH 42/42] Two small changes to style guide. The first change clarifies the use of intent on arguments to procedures. Specifically, pointer dummy arguments cannot have intent specified. Secondly, a rule was added to enforce spacing between procedure arguments. --- docs/source/devguide/styleguide.rst | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/docs/source/devguide/styleguide.rst b/docs/source/devguide/styleguide.rst index a758537493..5ac2371481 100644 --- a/docs/source/devguide/styleguide.rst +++ b/docs/source/devguide/styleguide.rst @@ -35,17 +35,17 @@ Don't use ``print *`` or ``write(*,*)``. If writing to a file, use a specific unit. Writing to standard output or standard error should be handled by the ``write_message`` subroutine or functionality in the error module. -------------------------- -Subroutines and Functions -------------------------- +---------- +Procedures +---------- -Above each subroutine/function, include a comment block giving a brief -description of what the subroutine or function does. +Above each procedure, include a comment block giving a brief description of what +the procedure does. -Arguments to subroutines/functions should be explicitly specified as intent(in), -intent(out), or intent(inout). +Nonpointer dummy arguments to procedures should be explicitly specified as +intent(in), intent(out), or intent(inout). -Include a comment describing what each argument to a subroutine/function is. +Include a comment describing what each argument to a procedure is. --------- Variables @@ -133,9 +133,11 @@ value of f90-continuation-indent in Emacs. Whitespace in Expressions ------------------------- +Use a single space between arguments to procedures. + Avoid extraneous whitespace in the following situations: -- In subroutine/function calls:: +- In procedure calls:: Yes: call somesub(x, y(2), z) No: call somesub( x, y( 2 ), z )