From 1b592f6a2d9571754658eda0a4947b6e993b99b6 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 2 May 2013 15:06:10 -0700 Subject: [PATCH 01/65] serial hdf5 statepoint file now written from statepoint --- src/eigenvalue.F90 | 8 +- src/global.F90 | 2 + src/hdf5_interface.F90 | 109 ++++++++++++++ src/state_point.F90 | 322 ++++++++++++++++++++++++++++++++++++++++- 4 files changed, 432 insertions(+), 9 deletions(-) diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index 660a1119f4..6749a65acd 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -183,11 +183,11 @@ contains if (master) call calculate_combined_keff() ! Create state point file -#ifdef HDF5 - call hdf5_write_state_point() -#else +!#ifdef HDF5 +! call hdf5_write_state_point() +!#else call write_state_point() -#endif +!#endif end if if (master .and. current_batch == n_batches) then diff --git a/src/global.F90 b/src/global.F90 index af20c135af..497fe6a966 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -241,6 +241,8 @@ module global integer(HID_T) :: hdf5_tallyresult_t ! Compound type for TallyResult integer(HID_T) :: hdf5_bank_t ! Compound type for Bank integer(HID_T) :: hdf5_integer8_t ! type for integer(8) + integer(HID_T) :: hdf5_state_point ! file id + integer(HID_T) :: hdf5_plist ! parallel property list integer :: hdf5_err ! error flag #endif diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 2aa5653fe8..936ec5661f 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -20,6 +20,12 @@ module hdf5_interface implicit none + ! define array writing interface + interface hdf5_write_array + module procedure hdf5_write_double_1Darray + module procedure hdf5_write_integer_1Darray + end interface hdf5_write_array + #ifdef HDF5 contains @@ -1260,6 +1266,73 @@ contains end subroutine hdf5_load_state_point +!=============================================================================== +! HDF5_FILE_CREATE +!=============================================================================== + + subroutine hdf5_file_create(filename, file_id) + + character(MAX_FILE_LEN) :: filename + integer(HID_T) :: file_id + + ! Create the file + call h5fcreate_f(trim(filename), H5F_ACC_TRUNC_F, file_id, hdf5_err) + + end subroutine hdf5_file_create + +!=============================================================================== +! HDF5_FILE_CLOSE +!=============================================================================== + + subroutine hdf5_file_close(file_id) + + integer(HID_T) :: file_id + + ! Close the file + call h5fclose_f(file_id, hdf5_err) + + end subroutine hdf5_file_close + +#ifdef MPI + +!=============================================================================== +! HDF5_PARALLEL_FILE_CREATE +!=============================================================================== + + subroutine hdf5_parallel_file_create(filename, file_id, plist_id) + + character(MAX_FILE_LEN) :: filename + integer(HID_T) :: file_id + integer(HID_T) :: plist_id + + ! Setup file access property list with parallel I/O access + call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) + call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) + + ! Create the file collectively + call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) + call h5fcreate_f(trim(filename), H5F_ACC_TRUNC_F, file_id, hdf5_err, & + access_prp = plist_id) + + end subroutine hdf5_parallel_file_create + +!=============================================================================== +! HDF5_PARALLEL_FILE_CLOSE +!=============================================================================== + + subroutine hdf5_parallel_file_close(file_id, plist_id) + + integer(HID_T) :: file_id + integer(HID_T) :: plist_id + + ! Close property list and the file + call h5pclose_f(plist_id, hdf5_err) + call h5fclose_f(file_id, hdf5_err) + + end subroutine hdf5_parallel_file_close + +#endif + !=============================================================================== ! HDF5_WRITE_INTEGER !=============================================================================== @@ -1278,6 +1351,24 @@ contains end subroutine hdf5_write_integer +!=============================================================================== +! HDF5_WRITE_INTEGER_1DARRAY +!=============================================================================== + + subroutine hdf5_write_integer_1Darray(group, name, buffer, rank, dims) + + integer(HID_T), intent(in) :: group + character(*), intent(in) :: name + integer, intent(in) :: buffer(:) + + integer :: rank + integer(HSIZE_T) :: dims(rank) + + call h5ltmake_dataset_int_f(group, name, rank, dims, & + buffer, hdf5_err) + + end subroutine hdf5_write_integer_1Darray + !=============================================================================== ! HDF5_WRITE_LONG !=============================================================================== @@ -1326,6 +1417,24 @@ contains end subroutine hdf5_write_double +!=============================================================================== +! HDF5_WRITE_DOUBLE_1DARRAY +!=============================================================================== + + subroutine hdf5_write_double_1Darray(group, name, buffer, rank, dims) + + integer(HID_T), intent(in) :: group + character(*), intent(in) :: name + real(8), intent(in) :: buffer(:) + + integer :: rank + integer(HSIZE_T) :: dims(rank) + + call h5ltmake_dataset_double_f(group, name, rank, dims, & + buffer, hdf5_err) + + end subroutine hdf5_write_double_1Darray + !=============================================================================== ! HDF5_READ_INTEGER !=============================================================================== diff --git a/src/state_point.F90 b/src/state_point.F90 index cf11676f28..190853c235 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -18,12 +18,13 @@ module state_point ! intervals, using the tag. !=============================================================================== - use error, only: warning, fatal_error + use error, only: warning, fatal_error use global - use math, only: t_percentile - use output, only: write_message, print_batch_keff, time_stamp - use string, only: to_str - use tally_header, only: TallyObject + use hdf5_interface + use math, only: t_percentile + use output, only: write_message, print_batch_keff, time_stamp + use string, only: to_str + use tally_header, only: TallyObject #ifdef MPI use mpi @@ -54,9 +55,24 @@ contains character(MAX_FILE_LEN) :: filename type(TallyObject), pointer :: t => null() +# ifdef HDF5 + integer(HSIZE_T) :: dims(1) ! dimensions of 1D arrays + integer(HSIZE_T) :: dims2(2) ! dimensions of 2D arrays + integer(HID_T) :: dspace ! identifier for dataspace + integer(HID_T) :: dset ! identifier for dataset + integer(HID_T) :: tallies_group ! "tallies" group + integer(HID_T) :: temp_group ! group for i-th tally or mesh + type(c_ptr) :: f_ptr ! Pointer for h5dwrite +#endif + ! Set filename for binary state point +#ifdef HDF5 + filename = trim(path_output) // 'statepoint.' // & + trim(to_str(current_batch)) // '.h5' +#else filename = trim(path_output) // 'statepoint.' // & trim(to_str(current_batch)) // '.binary' +#endif ! Write message message = "Creating state point " // trim(filename) // "..." @@ -67,8 +83,12 @@ contains ! PARALLEL I/O USING MPI-2 ROUTINES ! Open binary source file for reading +#ifdef HDF5 + call hdf5_file_create(filename, hdf5_state_point) +#else call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, MPI_MODE_CREATE + & MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpi_err) +#endif ! ========================================================================== ! RUN INFORMATION AND TALLY METADATA @@ -86,40 +106,102 @@ contains elseif (master) then ! Write number of realizations +#ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "n_realizations", n_realizations) +#else call MPI_FILE_WRITE(fh, n_realizations, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write global tallies +#ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "n_global_tallies", & + N_GLOBAL_TALLIES) + dims(1) = N_GLOBAL_TALLIES + print *,'GLOBAL:',rank,global_tallies + call h5screate_simple_f(1, dims, dspace, hdf5_err) + call h5dcreate_f(hdf5_state_point, "global_tallies", hdf5_tallyresult_t, & + dspace, dset, hdf5_err) + f_ptr = c_loc(global_tallies(1)) + call h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) +#else call MPI_FILE_WRITE(fh, N_GLOBAL_TALLIES, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, global_tallies, N_GLOBAL_TALLIES, & MPI_TALLYRESULT, MPI_STATUS_IGNORE, mpi_err) +#endif + ! Write tallies if (tallies_on) then + print *,'TALLIES ON' ! Indicate that tallies are on +#ifdef HDF5 + call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) + call hdf5_write_integer(tallies_group, "tallies_present", 1) +#else temp = 1 call MPI_FILE_WRITE(fh, temp, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write all tally results TALLY_RESULTS: do i = 1, n_tallies t => tallies(i) +#ifdef HDF5 + ! Open group for the i-th tally + call h5gopen_f(tallies_group, "tally" // to_str(i), & + temp_group, hdf5_err) + ! Write sum and sum_sq for each bin + dims2 = shape(t % results) + call h5screate_simple_f(2, dims2, dspace, hdf5_err) + call h5dcreate_f(temp_group, "results", hdf5_tallyresult_t, & + dspace, dset, hdf5_err) + f_ptr = c_loc(t % results(1, 1)) + CALL h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + + ! Close group for the i-th tally + call h5gclose_f(temp_group, hdf5_err) +#else n = size(t % results, 1) * size(t % results, 2) call MPI_FILE_WRITE(fh, t % results, n, MPI_TALLYRESULT, & MPI_STATUS_IGNORE, mpi_err) +#endif end do TALLY_RESULTS +#ifdef HDF5 + ! Close the tallies group + call h5gclose_f(tallies_group, hdf5_err) +#endif else ! Indicate that tallies are off +#ifdef HDF5 + call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) + call hdf5_write_integer(tallies_group, "tallies_present", 0) + call h5gclose_f(tallies_group, hdf5_err) +#else temp = 0 call MPI_FILE_WRITE(fh, temp, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif end if + call hdf5_file_close(hdf5_state_point) + message = 'STOPPING PARALLEL HDF5 RUN' + call fatal_error() end if ! ========================================================================== ! SOURCE BANK +#ifdef HDF5 + ! Close the serial HDF5 file and set logical for source separate + call hdf5_file_close(hdf5_state_point) + source_separate = .true. +#endif + if (run_mode == MODE_EIGENVALUE) then if (source_separate) then ! If the user has specified that the source sites should be written in @@ -156,7 +238,11 @@ contains end if ! Close binary source file +#ifdef HDF5 + call hdf5_file_close(hdf5_state_point) +#else call MPI_FILE_CLOSE(fh, mpi_err) +#endif #else ! Open binary state point file for writing @@ -336,44 +422,105 @@ contains integer :: n ! temporary array length type(TallyObject), pointer :: t => null() +#ifdef HDF5 + integer(HSIZE_T) :: dims(1) ! dimensions of 1D arrays + integer(HID_T) :: tallies_group ! "tallies" group + integer(HID_T) :: temp_group ! group for i-th tally or mesh + integer(HID_T) :: filter_group ! group for i-th filter + integer, allocatable :: temp_array(:) ! nuclide bin array +#endif + ! Write revision number for state point file +#ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "revision_statepoint", & + REVISION_STATEPOINT) +#else call MPI_FILE_WRITE(fh, REVISION_STATEPOINT, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write OpenMC version +#ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "version_major", VERSION_MAJOR) + call hdf5_write_integer(hdf5_state_point, "version_minor", VERSION_MINOR) + call hdf5_write_integer(hdf5_state_point, "version_release", VERSION_RELEASE) +#else call MPI_FILE_WRITE(fh, VERSION_MAJOR, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, VERSION_MINOR, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, VERSION_RELEASE, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write current date and time +#ifdef HDF5 + call h5ltmake_dataset_string_f(hdf5_state_point, "date_and_time", & + time_stamp(), hdf5_err) +#else call MPI_FILE_WRITE(fh, time_stamp(), 19, MPI_CHARACTER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write path to input +#ifdef HDF5 + call h5ltmake_dataset_string_f(hdf5_state_point, "path", & + path_input, hdf5_err) +#else call MPI_FILE_WRITE(fh, path_input, MAX_FILE_LEN, MPI_CHARACTER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write out random number seed +#ifdef HDF5 + call hdf5_write_long(hdf5_state_point, "seed", seed) +#else call MPI_FILE_WRITE(fh, seed, 1, MPI_INTEGER8, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write run information +#ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "run_mode", run_mode) + call hdf5_write_long(hdf5_state_point, "n_particles", n_particles) + call hdf5_write_integer(hdf5_state_point, "n_batches", n_batches) +#else call MPI_FILE_WRITE(fh, run_mode, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, n_particles, 1, MPI_INTEGER8, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, n_batches, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write out current batch number +#ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "current_batch", current_batch) +#else call MPI_FILE_WRITE(fh, current_batch, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write out information for eigenvalue run if (run_mode == MODE_EIGENVALUE) then +#ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "n_inactive", n_inactive) + call hdf5_write_integer(hdf5_state_point, "gen_per_batch", gen_per_batch) + + ! Write out keff and entropy + dims(1) = current_batch + call h5ltmake_dataset_double_f(hdf5_state_point, "k_batch", 1, & + dims, k_batch, hdf5_err) + dims(1) = current_batch*gen_per_batch + call h5ltmake_dataset_double_f(hdf5_state_point, "entropy", 1, & + dims, entropy, hdf5_err) + call hdf5_write_double(hdf5_state_point, "k_col_abs", k_col_abs) + call hdf5_write_double(hdf5_state_point, "k_col_tra", k_col_tra) + call hdf5_write_double(hdf5_state_point, "k_abs_tra", k_abs_tra) + dims(1) = 2 + call h5ltmake_dataset_double_f(hdf5_state_point, "k_combined", 1, & + dims, k_combined, hdf5_err) +#else call MPI_FILE_WRITE(fh, n_inactive, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, gen_per_batch, 1, MPI_INTEGER, & @@ -390,21 +537,54 @@ contains MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, k_combined, 2, MPI_REAL8, & MPI_STATUS_IGNORE, mpi_err) +#endif end if ! Write number of meshes +#ifdef HDF5 + call h5gcreate_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) + call hdf5_write_integer(tallies_group, "n_meshes", n_meshes) +#else call MPI_FILE_WRITE(fh, n_meshes, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write information for meshes MESH_LOOP: do i = 1, n_meshes +#ifdef HDF5 + ! Create temporary group for each mesh + call h5gcreate_f(tallies_group, "mesh" // to_str(i), & + temp_group, hdf5_err) + + ! Write id, type, and number of dimensions + call hdf5_write_integer(temp_group, "id", meshes(i) % id) + call hdf5_write_integer(temp_group, "type", meshes(i) % type) + call hdf5_write_integer(temp_group, "n_dimension", & + meshes(i) % n_dimension) +#else call MPI_FILE_WRITE(fh, meshes(i) % id, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, meshes(i) % type, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, meshes(i) % n_dimension, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif + ! Write mesh information +#ifdef HDF5 + dims(1) = meshes(i) % n_dimension + call hdf5_write_array(temp_group, "dimension", & + meshes(i) % dimension, 1, dims) + call hdf5_write_array(temp_group, "lower_left", & + meshes(i) % lower_left, 1, dims) + call hdf5_write_array(temp_group, "upper_right", & + meshes(i) % upper_right, 1, dims) + call hdf5_write_array(temp_group, "width", & + meshes(i) % width, 1, dims) + + ! Close temporary group for mesh + call h5gclose_f(temp_group, hdf5_err) +#else n = meshes(i) % n_dimension call MPI_FILE_WRITE(fh, meshes(i) % dimension, n, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) @@ -414,84 +594,216 @@ contains MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, meshes(i) % width, n, MPI_REAL8, & MPI_STATUS_IGNORE, mpi_err) +#endif end do MESH_LOOP ! Write number of tallies +#ifdef HDF5 + call hdf5_write_integer(tallies_group, "n_tallies", n_tallies) +#else call MPI_FILE_WRITE(fh, n_tallies, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif TALLY_METADATA: do i = 1, n_tallies ! Get pointer to tally t => tallies(i) +#ifdef HDF5 + ! Create group for this tally + call h5gcreate_f(tallies_group, "tally" // to_str(i), & + temp_group, hdf5_err) + ! Write id + call hdf5_write_integer(temp_group, "id", t % id) +#else call MPI_FILE_WRITE(fh, t % id, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write number of realizations +#ifdef HDF5 + call hdf5_write_integer(temp_group, "n_realizations", & + t % n_realizations) +#else call MPI_FILE_WRITE(fh, t % n_realizations, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write size of each tally +#ifdef HDF5 + call hdf5_write_integer(temp_group, "total_score_bins", & + t % total_score_bins) + call hdf5_write_integer(temp_group, "total_filter_bins", & + t % total_filter_bins) +#else call MPI_FILE_WRITE(fh, t % total_score_bins, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, t % total_filter_bins, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write number of filters +#ifdef HDF5 + call hdf5_write_integer(temp_group, "n_filters", t % n_filters) +#else call MPI_FILE_WRITE(fh, t % n_filters, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif FILTER_LOOP: do j = 1, t % n_filters ! Write type of filter +#ifdef HDF5 + call h5gcreate_f(temp_group, "filter" // to_str(j), filter_group, & + hdf5_err) +#else call MPI_FILE_WRITE(fh, t % filters(j) % type, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write number of bins for this filter +#ifdef HDF5 + call hdf5_write_integer(filter_group, "type", t % filters(j) % type) +#else call MPI_FILE_WRITE(fh, t % filters(j) % n_bins, & 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +#endif ! Write bins if (t % filters(j) % type == FILTER_ENERGYIN .or. & t % filters(j) % type == FILTER_ENERGYOUT) then +#ifdef HDF5 + dims(1) = size(t % filters(j) % real_bins) + call h5ltmake_dataset_double_f(filter_group, "bins", 1, & + dims, t % filters(j) % real_bins, hdf5_err) +#else n = size(t % filters(j) % real_bins) call MPI_FILE_WRITE(fh, t % filters(j) % real_bins, n, & MPI_REAL8, MPI_STATUS_IGNORE, mpi_err) +#endif else +#ifdef HDF5 + dims(1) = size(t % filters(j) % int_bins) + call h5ltmake_dataset_int_f(filter_group, "bins", 1, & + dims, t % filters(j) % int_bins, hdf5_err) +#else n = size(t % filters(j) % int_bins) call MPI_FILE_WRITE(fh, t % filters(j) % int_bins, n, & MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +#endif end if + +#ifdef HDF5 + ! Write name of type + select case (t % filters(j) % type) + case(FILTER_UNIVERSE) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "universe", hdf5_err) + case(FILTER_MATERIAL) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "material", hdf5_err) + case(FILTER_CELL) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "cell", hdf5_err) + case(FILTER_CELLBORN) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "cellborn", hdf5_err) + case(FILTER_SURFACE) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "surface", hdf5_err) + case(FILTER_MESH) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "mesh", hdf5_err) + case(FILTER_ENERGYIN) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "energy", hdf5_err) + case(FILTER_ENERGYOUT) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "energyout", hdf5_err) + end select + + ! Close group for this filter + call h5gclose_f(filter_group, hdf5_err) +#endif end do FILTER_LOOP ! Write number of nuclide bins +#ifdef HDF5 + call hdf5_write_integer(temp_group, "n_nuclide_bins", & + t % n_nuclide_bins) +#else call MPI_FILE_WRITE(fh, t % n_nuclide_bins, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Write nuclide bins +#ifdef HDF5 + allocate(temp_array(t % n_nuclide_bins)) +#endif NUCLIDE_LOOP: do j = 1, t % n_nuclide_bins if (t % nuclide_bins(j) > 0) then +#ifdef HDF5 + temp_array(j) = nuclides(t % nuclide_bins(j)) % zaid +#else call MPI_FILE_WRITE(fh, nuclides(t % nuclide_bins(j)) % zaid, & 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +#endif else +#ifdef HDF5 + temp_array(j) = t % nuclide_bins(j) +#else call MPI_FILE_WRITE(fh, t % nuclide_bins(j), 1, & MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +#endif end if end do NUCLIDE_LOOP +#ifdef HDF5 + ! Write and deallocate nuclide bins + dims(1) = t % n_nuclide_bins + call h5ltmake_dataset_int_f(temp_group, "nuclide_bins", 1, & + dims, temp_array, hdf5_err) + deallocate(temp_array) +#endif + ! Write number of score bins, score bins, and scatt order +#ifdef HDF5 + call hdf5_write_integer(temp_group, "n_score_bins", & + t % n_score_bins) + dims(1) = t % n_score_bins + call h5ltmake_dataset_int_f(temp_group, "score_bins", 1, & + dims, t % score_bins, hdf5_err) + call h5ltmake_dataset_int_f(temp_group, "scatt_order", 1, & + dims, t % scatt_order, hdf5_err) +#else call MPI_FILE_WRITE(fh, t % n_score_bins, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, t % score_bins, t % n_score_bins, & MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_WRITE(fh, t % scatt_order, t % n_score_bins, & MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +#endif ! Write number of user score bins +#ifdef HDF5 + call hdf5_write_integer(temp_group, "n_user_score_bins", & + t % n_user_score_bins) +#else call MPI_FILE_WRITE(fh, t % n_user_score_bins, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif + +#ifdef HDF5 + ! Close tally group + call h5gclose_f(temp_group, hdf5_err) +#endif end do TALLY_METADATA +# ifdef HDF5 + ! Close tallies group + call h5gclose_f(tallies_group, hdf5_err) +#endif + end subroutine write_state_point_header #endif From 77eb1b2a8f7e6ddb1683f362344015c4592dc57a Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 3 May 2013 06:32:30 -0700 Subject: [PATCH 02/65] added code to write source bank in HDF5 parallel --- src/state_point.F90 | 52 +++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 48 insertions(+), 4 deletions(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index 190853c235..5e99527d05 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -188,9 +188,6 @@ contains MPI_STATUS_IGNORE, mpi_err) #endif end if - call hdf5_file_close(hdf5_state_point) - message = 'STOPPING PARALLEL HDF5 RUN' - call fatal_error() end if ! ========================================================================== @@ -209,7 +206,11 @@ contains ! write it separately if (source_write) then +#ifdef HDF5 + path_source = "source." // trim(to_str(current_batch)) // ".h5" +#else path_source = "source." // trim(to_str(current_batch)) // ".binary" +#endif call write_source_binary() end if elseif (source_write) then @@ -1435,14 +1436,50 @@ contains #ifdef MPI integer :: fh ! file handle integer(MPI_OFFSET_KIND) :: offset ! offset in memory (0=beginning of file) + integer(HID_T) :: hdf5_source + integer(HSIZE_T) :: dims(1) + integer(HID_T) :: filespace + integer(HID_T) :: memspace + character(6) :: dsetname = 'source' + integer(HID_T) :: dset_id + integer(HID_T) :: plist_id + type(c_ptr) :: f_ptr ! ========================================================================== ! PARALLEL I/O USING MPI-2 ROUTINES - ! Open binary source file for reading + ! Open binary source file for writing +#ifdef HDF5 +! call hdf5_parallel_file_create(trim(path_source), hdf5_source, hdf5_plist) +#else call MPI_FILE_OPEN(MPI_COMM_WORLD, path_source, MPI_MODE_CREATE + & MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpi_err) +#endif +#ifdef HDF5 + call h5pclose_f(hdf5_plist, hdf5_err) + call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) + call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) + call h5fcreate_f('source.h5', H5F_ACC_TRUNC_F, hdf5_source, hdf5_err, access_prp=plist_id) + call h5pclose_f(plist_id, hdf5_err) + dims(1) = n_particles + call h5screate_simple_f(1, dims, filespace, hdf5_err) + call h5dcreate_f(hdf5_source, dsetname, hdf5_bank_t, filespace, dset_id, hdf5_err) + call h5sclose_f(filespace, hdf5_err) + call h5screate_simple_f(1, (/work/), memspace, hdf5_err) + call h5dget_space_f(dset_id, filespace, hdf5_err) + call h5sselect_hyperslab_f(filespace, H5S_SELECT_SET_F, (/bank_first-1/), (/work/), hdf5_err) + call h5pcreate_f(H5P_DATASET_XFER_F, hdf5_plist, hdf5_err) + call h5pset_dxpl_mpio_f(hdf5_plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + f_ptr = c_loc(source_bank(1)) + call h5dwrite_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err, file_space_id = filespace, mem_space_id = memspace, xfer_prp = hdf5_plist) + call h5sclose_f(filespace, hdf5_err) + call h5sclose_f(memspace, hdf5_err) + call h5dclose_f(dset_id, hdf5_err) + call hdf5_parallel_file_close(hdf5_source, hdf5_plist) + call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) + call MPI_ABORT(MPI_COMM_WORLD,-1,mpi_err) +#else if (master) then offset = 0 call MPI_FILE_WRITE_AT(fh, offset, n_particles, 1, MPI_INTEGER8, & @@ -1455,9 +1492,16 @@ contains ! Write all source sites call MPI_FILE_WRITE_AT(fh, offset, source_bank(1), work, MPI_BANK, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Close binary source file +#ifdef HDF5 +! call hdf5_parallel_file_close(hdf5_source, hdf5_plist) + message = "done with source" + call fatal_error() +#else call MPI_FILE_CLOSE(fh, mpi_err) +#endif #else ! ========================================================================== From 54aa36780dbe89d1522cef31bdf1feaeffcaf627 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 3 May 2013 15:01:45 +0000 Subject: [PATCH 03/65] only master opens/closes statepoint HDF5 file --- src/state_point.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index 5e99527d05..31e5497ff6 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -84,7 +84,7 @@ contains ! Open binary source file for reading #ifdef HDF5 - call hdf5_file_create(filename, hdf5_state_point) + if (master) call hdf5_file_create(filename, hdf5_state_point) #else call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, MPI_MODE_CREATE + & MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpi_err) @@ -195,7 +195,7 @@ contains #ifdef HDF5 ! Close the serial HDF5 file and set logical for source separate - call hdf5_file_close(hdf5_state_point) + if (master) call hdf5_file_close(hdf5_state_point) source_separate = .true. #endif @@ -240,7 +240,7 @@ contains ! Close binary source file #ifdef HDF5 - call hdf5_file_close(hdf5_state_point) +! call hdf5_file_close(hdf5_state_point) #else call MPI_FILE_CLOSE(fh, mpi_err) #endif From 57e3e3f2a34ed16ac89c72782c320ddff4bac4a5 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Sat, 4 May 2013 13:25:45 -0700 Subject: [PATCH 04/65] added some code to read in source info from HDF5 source file --- src/initialize.F90 | 3 +- src/state_point.F90 | 191 +++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 182 insertions(+), 12 deletions(-) diff --git a/src/initialize.F90 b/src/initialize.F90 index a1518cd218..18dfff601a 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -122,7 +122,8 @@ contains ! If this is a restart run, load the state point data and binary source ! file #ifdef HDF5 - if (restart_run) call hdf5_load_state_point() +! if (restart_run) call hdf5_load_state_point() + if (restart_run) call load_state_point() #else if (restart_run) call load_state_point() #endif diff --git a/src/state_point.F90 b/src/state_point.F90 index 31e5497ff6..09796595c3 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -118,7 +118,6 @@ contains call hdf5_write_integer(hdf5_state_point, "n_global_tallies", & N_GLOBAL_TALLIES) dims(1) = N_GLOBAL_TALLIES - print *,'GLOBAL:',rank,global_tallies call h5screate_simple_f(1, dims, dspace, hdf5_err) call h5dcreate_f(hdf5_state_point, "global_tallies", hdf5_tallyresult_t, & dspace, dset, hdf5_err) @@ -135,7 +134,6 @@ contains ! Write tallies if (tallies_on) then - print *,'TALLIES ON' ! Indicate that tallies are on #ifdef HDF5 call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) @@ -951,21 +949,47 @@ contains integer :: k ! loop index #endif +#ifdef HDF5 + integer(HID_T) :: hdf5_state_point ! identifier for state point file + integer(HID_T) :: tally_group ! identifier for tally group + integer(HID_T) :: tallies_group + integer(HID_T) :: temp_group + integer(HID_T) :: dset ! identifier for dataset + integer(HSIZE_T) :: dims(1) ! dimensions of 1D arrays + integer(HID_T) :: hdf5_source + integer(HID_T) :: filespace + integer(HID_T) :: memspace + character(6) :: dsetname = 'source' + integer(HID_T) :: dset_id + integer(HID_T) :: plist_id + type(c_ptr) :: f_ptr + integer(HSIZE_T) :: maxdims(1) +#endif + ! Write message message = "Loading state point " // trim(path_state_point) // "..." call write_message(1) #ifdef MPI ! Open binary state point file for reading +#ifdef HDF5 + call h5fopen_f(path_state_point, H5F_ACC_RDONLY_F, & + hdf5_state_point, hdf5_err) +#else call MPI_FILE_OPEN(MPI_COMM_WORLD, path_state_point, MPI_MODE_RDONLY, & MPI_INFO_NULL, fh, mpi_err) +#endif ! ========================================================================== ! RUN INFORMATION AND TALLY METADATA ! Raad revision number for state point file and make sure it matches with ! current version +#ifdef HDF5 + call hdf5_read_integer(hdf5_state_point, "revision_statepoint", temp(1)) +#else call MPI_FILE_READ_ALL(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +#endif if (temp(1) /= REVISION_STATEPOINT) then message = "State point binary version does not match current version " & // "in OpenMC." @@ -973,6 +997,11 @@ contains end if ! Read OpenMC version +#ifdef HDF5 +! call hdf5_read_integer(hdf5_state_point, "version_major", temp(1)) +! call hdf5_read_integer(hdf5_state_point, "version_minor", temp(2)) +! call hdf5_read_integer(hdf5_state_point, "version_release", temp(3)) +#else call MPI_FILE_READ_ALL(fh, temp, 3, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) if (temp(1) /= VERSION_MAJOR .or. temp(2) /= VERSION_MINOR & .or. temp(3) /= VERSION_RELEASE) then @@ -980,33 +1009,65 @@ contains "of OpenMC." call warning() end if +#endif ! Read date and time +#ifndef HDF5 call MPI_FILE_READ_ALL(fh, current_time, 19, MPI_CHARACTER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Read path to input +#ifndef HDF5 call MPI_FILE_READ_ALL(fh, path_temp, MAX_FILE_LEN, MPI_CHARACTER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Read and overwrite random number seed +#ifdef HDF5 + call hdf5_read_long(hdf5_state_point, "seed", seed) +#else call MPI_FILE_READ_ALL(fh, seed, 1, MPI_INTEGER8, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Read and overwrite run information +#ifdef HDF5 + call hdf5_read_integer(hdf5_state_point, "run_mode", mode) + call hdf5_read_long(hdf5_state_point, "n_particles", n_particles) + call hdf5_read_integer(hdf5_state_point, "n_batches", n_batches) +#else call MPI_FILE_READ_ALL(fh, mode, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_READ_ALL(fh, n_particles, 1, MPI_INTEGER8, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_READ_ALL(fh, n_batches, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Read batch number to restart at +#ifdef HDF5 + call hdf5_read_integer(hdf5_state_point, "current_batch", restart_batch) +#else call MPI_FILE_READ_ALL(fh, restart_batch, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) +#endif ! Read information specific to eigenvalue run if (mode == MODE_EIGENVALUE) then +#ifdef HDF5 + call hdf5_read_integer(hdf5_state_point, "n_inactive", n_inactive) + call hdf5_read_integer(hdf5_state_point, "gen_per_batch", gen_per_batch) + dims(1) = restart_batch + call h5ltread_dataset_double_f(hdf5_state_point, "k_batch", & + k_batch(1:restart_batch), dims, hdf5_err) + dims(1) = restart_batch*gen_per_batch + call h5ltread_dataset_double_f(hdf5_state_point, "entropy", & + entropy(1:restart_batch*gen_per_batch), dims, hdf5_err) + call hdf5_read_double(hdf5_state_point, "k_col_abs", k_col_abs) + call hdf5_read_double(hdf5_state_point, "k_col_tra", k_col_tra) + call hdf5_read_double(hdf5_state_point, "k_abs_tra", k_abs_tra) +#else call MPI_FILE_READ_ALL(fh, n_inactive, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) call MPI_FILE_READ_ALL(fh, gen_per_batch, 1, MPI_INTEGER, & @@ -1025,18 +1086,52 @@ contains call MPI_FILE_READ_ALL(fh, real_array, 2, MPI_REAL8, & MPI_STATUS_IGNORE, mpi_err) deallocate(real_array) +#endif end if +#ifdef HDF5 + call hdf5_read_integer(hdf5_state_point, "n_realizations", n_realizations) +#endif + if (master) then ! Read number of meshes +#ifdef HDF5 +! call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) +! call hdf5_read_integer(tallies_group, "n_meshes", temp(1)) +#else call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) if (temp(1) /= n_meshes) then message = "Number of meshes does not match in state point." call fatal_error() end if - +#endif MESH_LOOP: do i = 1, n_meshes ! Read id, mesh type, and dimension +#ifdef HDF5 + ! Create temporary group for each mesh +! call h5gcreate_f(tallies_group, "mesh" // to_str(i), & +! temp_group, hdf5_err) + + ! Write id, type, and number of dimensions +! call hdf5_write_integer(temp_group, "id", meshes(i) % id) +! call hdf5_write_integer(temp_group, "type", meshes(i) % type) +! call hdf5_write_integer(temp_group, "n_dimension", & +! meshes(i) % n_dimension) + + ! Write mesh information +! dims(1) = meshes(i) % n_dimension +! call h5ltmake_dataset_int_f(temp_group, "dimension", 1, & +! dims, meshes(i) % dimension, hdf5_err) +! call h5ltmake_dataset_double_f(temp_group, "lower_left", 1, & +! dims, meshes(i) % lower_left, hdf5_err) +! call h5ltmake_dataset_double_f(temp_group, "upper_right", 1, & +! dims, meshes(i) % upper_right, hdf5_err) +! call h5ltmake_dataset_double_f(temp_group, "width", 1, & +! dims, meshes(i) % width, hdf5_err) + + ! Close temporary group for mesh +! call h5gclose_f(temp_group, hdf5_err) +#else call MPI_FILE_READ(fh, temp, 3, MPI_INTEGER, MPI_STATUS_IGNORE, & mpi_err) @@ -1044,16 +1139,22 @@ contains call MPI_FILE_GET_POSITION(fh, offset, mpi_err) offset = offset + temp(3)*(4 + 3*8) call MPI_FILE_SEEK(fh, offset, MPI_SEEK_SET, mpi_err) +#endif end do MESH_LOOP ! Read number of tallies and make sure it matches +#ifdef HDF5 +! call hdf5_write_integer(tallies_group, "n_tallies", temp(1)) +#else call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) if (temp(1) /= n_tallies) then message = "Number of tallies does not match in state point." call fatal_error() end if - +#endif +#ifndef HDF5 TALLY_METADATA: do i = 1, n_tallies + ! Read tally id call MPI_FILE_READ(fh, tallies(i) % id, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) @@ -1125,8 +1226,12 @@ contains call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) end do TALLY_METADATA +#endif ! Read number of realizations for global tallies +#ifdef HDF5 +! call hdf5_read_integer(hdf5_state_point, "n_realizations", n_realizations) +#else call MPI_FILE_READ(fh, n_realizations, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) @@ -1136,13 +1241,31 @@ contains message = "Number of global tallies does not match in state point." call fatal_error() end if +#endif ! Read global tally data +#ifdef HDF5 + ! Open global tallies dataset + call h5dopen_f(hdf5_state_point, "global_tallies", dset, hdf5_err) + + ! Read global tallies + f_ptr = c_loc(global_tallies(1)) + call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + + ! Close global tallies dataset + call h5dclose_f(dset, hdf5_err) +#else call MPI_FILE_READ(fh, global_tallies, N_GLOBAL_TALLIES, & MPI_TALLYRESULT, MPI_STATUS_IGNORE, mpi_err) - +#endif ! Check if tally results are present +#ifdef HDF5 + call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) + call hdf5_read_integer(tallies_group, "tallies_present", temp(1)) + call h5gclose_f(tallies_group, hdf5_err) +#else call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +#endif ! ======================================================================= ! TALLY RESULTS @@ -1150,17 +1273,65 @@ contains ! Read sum and sum squared if (temp(1) == 1) then TALLY_RESULTS: do i = 1, n_tallies +#ifdef HDF5 + ! Open tally group + call h5gopen_f(hdf5_state_point, "tallies/tally" // & + to_str(i), tally_group, hdf5_err) + + ! Read number of realizations + call hdf5_read_integer(tally_group, "n_realizations", & + tallies(i) % n_realizations) + + ! Open dataset for tally results + call h5dopen_f(tally_group, "results", dset, hdf5_err) + + ! Read sum and sum_sq for each tally bin + f_ptr = c_loc(tallies(i) % results(1,1)) + call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + + ! Close dataset for tally results + call h5dclose_f(dset, hdf5_err) + + ! Close tally group + call h5gclose_f(tally_group, hdf5_err) +#else n = size(tallies(i) % results, 1) * size(tallies(i) % results, 2) call MPI_FILE_READ(fh, tallies(i) % results, n, MPI_TALLYRESULT, & MPI_STATUS_IGNORE, mpi_err) +#endif end do TALLY_RESULTS end if end if +#ifdef HDF5 + call h5fclose_f(hdf5_state_point, mpi_err) +#endif + ! ========================================================================== ! SOURCE BANK if (run_mode == MODE_EIGENVALUE) then +#ifdef HDF5 + path_source = "source." // trim(to_str(current_batch)) // ".h5" + call h5pclose_f(hdf5_plist, hdf5_err) + call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) + call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) + call h5fopen_f(trim(path_source), H5F_ACC_RDONLY_F, hdf5_source, hdf5_err, access_prp=plist_id) + call h5pclose_f(plist_id, hdf5_err) + call h5dopen_f(hdf5_source, dsetname, dset_id, hdf5_err) + call h5dget_space_f(dset_id, filespace, hdf5_err) + call h5sselect_hyperslab_f(filespace, H5S_SELECT_SET_F, (/bank_first-1/), (/work/), hdf5_err) + call h5screate_simple_f(1, (/work/), memspace, hdf5_err) + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdf5_err) + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + f_ptr = c_loc(source_bank(1)) + call h5dread_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err, file_space_id = filespace, mem_space_id = memspace, xfer_prp = plist_id) + call h5sclose_f(filespace, hdf5_err) + call h5sclose_f(memspace, hdf5_err) + call h5dclose_f(dset_id, hdf5_err) + call hdf5_parallel_file_close(hdf5_source, plist_id) + if (master) write(15,*) source_bank +#else ! Get current offset for master if (master) call MPI_FILE_GET_POSITION(fh, offset, mpi_err) @@ -1180,11 +1351,13 @@ contains ! Write all source sites call MPI_FILE_READ_AT(fh, offset, source_bank(1), work, MPI_BANK, & MPI_STATUS_IGNORE, mpi_err) +#endif end if ! Close binary state point file +#ifndef HDF5 call MPI_FILE_CLOSE(fh, mpi_err) - +#endif #else ! Open binary state point file for writing open(UNIT=UNIT_STATE, FILE=path_state_point, STATUS='old', & @@ -1460,7 +1633,7 @@ contains call h5pclose_f(hdf5_plist, hdf5_err) call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) - call h5fcreate_f('source.h5', H5F_ACC_TRUNC_F, hdf5_source, hdf5_err, access_prp=plist_id) + call h5fcreate_f(trim(path_source), H5F_ACC_TRUNC_F, hdf5_source, hdf5_err, access_prp=plist_id) call h5pclose_f(plist_id, hdf5_err) dims(1) = n_particles call h5screate_simple_f(1, dims, filespace, hdf5_err) @@ -1477,8 +1650,6 @@ contains call h5sclose_f(memspace, hdf5_err) call h5dclose_f(dset_id, hdf5_err) call hdf5_parallel_file_close(hdf5_source, hdf5_plist) - call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) - call MPI_ABORT(MPI_COMM_WORLD,-1,mpi_err) #else if (master) then offset = 0 @@ -1497,8 +1668,6 @@ contains ! Close binary source file #ifdef HDF5 ! call hdf5_parallel_file_close(hdf5_source, hdf5_plist) - message = "done with source" - call fatal_error() #else call MPI_FILE_CLOSE(fh, mpi_err) #endif From 0edef5e34cee906e094697de846c40c02e4ebb21 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Sat, 4 May 2013 19:48:02 -0400 Subject: [PATCH 05/65] replaced current batch with restart batch for restart source file name --- src/state_point.F90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index 09796595c3..400e868c88 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -1305,6 +1305,7 @@ contains #ifdef HDF5 call h5fclose_f(hdf5_state_point, mpi_err) + print *,'HDERE' #endif ! ========================================================================== @@ -1312,8 +1313,9 @@ contains if (run_mode == MODE_EIGENVALUE) then #ifdef HDF5 - path_source = "source." // trim(to_str(current_batch)) // ".h5" - call h5pclose_f(hdf5_plist, hdf5_err) + print *,'CURRENT BATCH',rank,restart_batch + path_source = "source." // trim(to_str(restart_batch)) // ".h5" +! call h5pclose_f(hdf5_plist, hdf5_err) call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) call h5fopen_f(trim(path_source), H5F_ACC_RDONLY_F, hdf5_source, hdf5_err, access_prp=plist_id) @@ -1329,7 +1331,8 @@ contains call h5sclose_f(filespace, hdf5_err) call h5sclose_f(memspace, hdf5_err) call h5dclose_f(dset_id, hdf5_err) - call hdf5_parallel_file_close(hdf5_source, plist_id) + call h5pclose_f(plist_id, hdf5_err) + call h5fclose_f(hdf5_source, hdf5_err) if (master) write(15,*) source_bank #else ! Get current offset for master @@ -1630,7 +1633,6 @@ contains #endif #ifdef HDF5 - call h5pclose_f(hdf5_plist, hdf5_err) call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) call h5fcreate_f(trim(path_source), H5F_ACC_TRUNC_F, hdf5_source, hdf5_err, access_prp=plist_id) @@ -1642,14 +1644,16 @@ contains call h5screate_simple_f(1, (/work/), memspace, hdf5_err) call h5dget_space_f(dset_id, filespace, hdf5_err) call h5sselect_hyperslab_f(filespace, H5S_SELECT_SET_F, (/bank_first-1/), (/work/), hdf5_err) - call h5pcreate_f(H5P_DATASET_XFER_F, hdf5_plist, hdf5_err) - call h5pset_dxpl_mpio_f(hdf5_plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdf5_err) + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdf5_err) f_ptr = c_loc(source_bank(1)) - call h5dwrite_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err, file_space_id = filespace, mem_space_id = memspace, xfer_prp = hdf5_plist) + call h5dwrite_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err, file_space_id = filespace, mem_space_id = memspace, & + xfer_prp = plist_id) call h5sclose_f(filespace, hdf5_err) call h5sclose_f(memspace, hdf5_err) call h5dclose_f(dset_id, hdf5_err) - call hdf5_parallel_file_close(hdf5_source, hdf5_plist) + call h5pclose_f(plist_id, hdf5_err) + call h5fclose_f(hdf5_source, hdf5_err) #else if (master) then offset = 0 From 0b821b7a3dd5ed9ca551b0416d05b47a8d360a2c Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Sun, 5 May 2013 20:53:20 -0400 Subject: [PATCH 06/65] cleaned up statepoint writing routines --- src/state_point.F90 | 1135 ++++++++++++++++++++----------------------- 1 file changed, 537 insertions(+), 598 deletions(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index 400e868c88..ae5b2d3ab6 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -65,7 +65,7 @@ contains type(c_ptr) :: f_ptr ! Pointer for h5dwrite #endif - ! Set filename for binary state point + ! Set filename for state point #ifdef HDF5 filename = trim(path_output) // 'statepoint.' // & trim(to_str(current_batch)) // '.h5' @@ -78,17 +78,16 @@ contains message = "Creating state point " // trim(filename) // "..." call write_message(1) -#ifdef MPI - ! ========================================================================== - ! PARALLEL I/O USING MPI-2 ROUTINES - - ! Open binary source file for reading -#ifdef HDF5 - if (master) call hdf5_file_create(filename, hdf5_state_point) -#else - call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, MPI_MODE_CREATE + & - MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpi_err) -#endif + ! Create statepoint file +# ifdef HDF5 + if (master) call hdf5_file_create(filename, hdf5_state_point) +# elif MPI + call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, MPI_MODE_CREATE + & + MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpi_err) +# else + open(UNIT=UNIT_STATE, FILE=filename, STATUS='replace', & + ACCESS='stream') +# endif ! ========================================================================== ! RUN INFORMATION AND TALLY METADATA @@ -106,304 +105,144 @@ contains elseif (master) then ! Write number of realizations -#ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "n_realizations", n_realizations) -#else - call MPI_FILE_WRITE(fh, n_realizations, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "n_realizations", & + n_realizations) +# elif MPI + call MPI_FILE_WRITE(fh, n_realizations, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) n_realizations +# endif ! Write global tallies -#ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "n_global_tallies", & - N_GLOBAL_TALLIES) - dims(1) = N_GLOBAL_TALLIES - call h5screate_simple_f(1, dims, dspace, hdf5_err) - call h5dcreate_f(hdf5_state_point, "global_tallies", hdf5_tallyresult_t, & - dspace, dset, hdf5_err) - f_ptr = c_loc(global_tallies(1)) - call h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) -#else - call MPI_FILE_WRITE(fh, N_GLOBAL_TALLIES, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, global_tallies, N_GLOBAL_TALLIES, & - MPI_TALLYRESULT, MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "n_global_tallies", & + N_GLOBAL_TALLIES) + dims(1) = N_GLOBAL_TALLIES + call h5screate_simple_f(1, dims, dspace, hdf5_err) + call h5dcreate_f(hdf5_state_point, "global_tallies", & + hdf5_tallyresult_t, dspace, dset, hdf5_err) + f_ptr = c_loc(global_tallies(1)) + call h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) +# elif MPI + call MPI_FILE_WRITE(fh, N_GLOBAL_TALLIES, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, global_tallies, N_GLOBAL_TALLIES, & + MPI_TALLYRESULT, MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) N_GLOBAL_TALLIES + GLOBAL_TALLIES_LOOP: do i = 1, N_GLOBAL_TALLIES + write(UNIT_STATE) global_tallies(i) % sum + write(UNIT_STATE) global_tallies(i) % sum_sq + end do GLOBAL_TALLIES_LOOP +# endif ! Write tallies if (tallies_on) then - ! Indicate that tallies are on + #ifdef HDF5 + ! Open group "tallies" call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) - call hdf5_write_integer(tallies_group, "tallies_present", 1) -#else - temp = 1 - call MPI_FILE_WRITE(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) #endif + ! Indicate that tallies are on +# ifdef HDF5 + call hdf5_write_integer(tallies_group, "tallies_present", 1) +# elif MPI + temp = 1 + call MPI_FILE_WRITE(fh, temp, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) 1 +# endif + ! Write all tally results TALLY_RESULTS: do i = 1, n_tallies t => tallies(i) #ifdef HDF5 - ! Open group for the i-th tally - call h5gopen_f(tallies_group, "tally" // to_str(i), & - temp_group, hdf5_err) + ! Open group for the i-th tally + call h5gopen_f(tallies_group, "tally" // to_str(i), & + temp_group, hdf5_err) +#endif - ! Write sum and sum_sq for each bin - dims2 = shape(t % results) - call h5screate_simple_f(2, dims2, dspace, hdf5_err) - call h5dcreate_f(temp_group, "results", hdf5_tallyresult_t, & - dspace, dset, hdf5_err) - f_ptr = c_loc(t % results(1, 1)) - CALL h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) + ! Write sum and sum_sq for each bin +# ifdef HDF5 + dims2 = shape(t % results) + call h5screate_simple_f(2, dims2, dspace, hdf5_err) + call h5dcreate_f(temp_group, "results", hdf5_tallyresult_t, & + dspace, dset, hdf5_err) + f_ptr = c_loc(t % results(1, 1)) + call h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) +# elif MPI + n = size(t % results, 1) * size(t % results, 2) + call MPI_FILE_WRITE(fh, t % results, n, MPI_TALLYRESULT, & + MPI_STATUS_IGNORE, mpi_err) +# else + do k = 1, size(t % results, 2) + do j = 1, size(t % results, 1) + write(UNIT_STATE) t % results(j,k) % sum + write(UNIT_STATE) t % results(j,k) % sum_sq + end do + end do +# endif - ! Close group for the i-th tally - call h5gclose_f(temp_group, hdf5_err) -#else - n = size(t % results, 1) * size(t % results, 2) - call MPI_FILE_WRITE(fh, t % results, n, MPI_TALLYRESULT, & - MPI_STATUS_IGNORE, mpi_err) +#ifdef HDF5 + ! Close group for the i-th tally + call h5gclose_f(temp_group, hdf5_err) #endif end do TALLY_RESULTS + #ifdef HDF5 ! Close the tallies group call h5gclose_f(tallies_group, hdf5_err) #endif + else ! Indicate that tallies are off -#ifdef HDF5 - call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) - call hdf5_write_integer(tallies_group, "tallies_present", 0) - call h5gclose_f(tallies_group, hdf5_err) -#else - temp = 0 - call MPI_FILE_WRITE(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) + call hdf5_write_integer(tallies_group, "tallies_present", 0) + call h5gclose_f(tallies_group, hdf5_err) +# elif MPI + temp = 0 + call MPI_FILE_WRITE(fh, temp, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) 0 +# endif end if end if - ! ========================================================================== - ! SOURCE BANK - -#ifdef HDF5 - ! Close the serial HDF5 file and set logical for source separate - if (master) call hdf5_file_close(hdf5_state_point) - source_separate = .true. -#endif + ! Append more output data in statepoint file here, source last + ! Write out source bank if (run_mode == MODE_EIGENVALUE) then - if (source_separate) then - ! If the user has specified that the source sites should be written in - ! a separate file, we make a call to the appropriate subroutine to - ! write it separately - - if (source_write) then -#ifdef HDF5 + if (source_write) then +# ifdef HDF5 path_source = "source." // trim(to_str(current_batch)) // ".h5" -#else +# else path_source = "source." // trim(to_str(current_batch)) // ".binary" -#endif - call write_source_binary() - end if - elseif (source_write) then - ! Otherwise, write the source sites in the state point file - - ! Get current offset for master - if (master) call MPI_FILE_GET_POSITION(fh, offset, mpi_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 - - ! Set 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 - call MPI_FILE_WRITE_AT(fh, offset, source_bank(1), work, MPI_BANK, & - MPI_STATUS_IGNORE, mpi_err) +# endif + call write_source() end if + endif + + ! Close statepoint file if it hasn't already been closed + if (.not. source_separate) then +# ifdef HDF5 + if (master) call h5fclose_f(hdf5_state_point, hdf5_err) +# elif MPI + call MPI_FILE_CLOSE(fh, mpi_err) +# else + close(UNIT_STATE) +# endif end if - ! Close binary source file -#ifdef HDF5 -! call hdf5_file_close(hdf5_state_point) -#else - call MPI_FILE_CLOSE(fh, mpi_err) -#endif - -#else - ! Open binary state point file for writing - open(UNIT=UNIT_STATE, FILE=filename, STATUS='replace', & - ACCESS='stream') - - ! Write revision number for state point file - write(UNIT_STATE) REVISION_STATEPOINT - - ! Write OpenMC version - write(UNIT_STATE) VERSION_MAJOR, VERSION_MINOR, VERSION_RELEASE - - ! Write current date and time - write(UNIT_STATE) time_stamp() - - ! Write path to input - write(UNIT_STATE) path_input - - ! Write out random number seed - write(UNIT_STATE) seed - - ! Write run information - write(UNIT_STATE) run_mode, n_particles, n_batches - - ! Write out current batch number - write(UNIT_STATE) current_batch - - ! Write out information for eigenvalue run - if (run_mode == MODE_EIGENVALUE) then - write(UNIT_STATE) n_inactive, gen_per_batch - write(UNIT_STATE) k_batch(1:current_batch) - write(UNIT_STATE) entropy(1:current_batch*gen_per_batch) - write(UNIT_STATE) k_col_abs - write(UNIT_STATE) k_col_tra - write(UNIT_STATE) k_abs_tra - write(UNIT_STATE) k_combined - end if - - ! Write number of meshes - write(UNIT_STATE) n_meshes - - ! Write information for meshes - MESH_LOOP: do i = 1, n_meshes - write(UNIT_STATE) meshes(i) % id - write(UNIT_STATE) meshes(i) % type - write(UNIT_STATE) meshes(i) % n_dimension - write(UNIT_STATE) meshes(i) % dimension - write(UNIT_STATE) meshes(i) % lower_left - write(UNIT_STATE) meshes(i) % upper_right - write(UNIT_STATE) meshes(i) % width - end do MESH_LOOP - - ! Write number of tallies - write(UNIT_STATE) n_tallies - - TALLY_METADATA: do i = 1, n_tallies - ! Get pointer to tally - t => tallies(i) - - ! Write id - write(UNIT_STATE) t % id - - ! Number of realizations - write(UNIT_STATE) t % n_realizations - - ! Write size of each dimension of tally results array - write(UNIT_STATE) t % total_score_bins - write(UNIT_STATE) t % total_filter_bins - - ! Write number of filters - write(UNIT_STATE) t % n_filters - - FILTER_LOOP: do j = 1, t % n_filters - ! Write type of filter - write(UNIT_STATE) t % filters(j) % type - - ! Write number of bins for this filter - write(UNIT_STATE) t % filters(j) % n_bins - - ! Write filter bins - if (t % filters(j) % type == FILTER_ENERGYIN .or. & - t % filters(j) % type == FILTER_ENERGYOUT) then - write(UNIT_STATE) t % filters(j) % real_bins - else - write(UNIT_STATE) t % filters(j) % int_bins - end if - end do FILTER_LOOP - - ! Write number of nuclide bins - write(UNIT_STATE) t % n_nuclide_bins - - ! Write nuclide bins - NUCLIDE_LOOP: do j = 1, t % n_nuclide_bins - if (t % nuclide_bins(j) > 0) then - write(UNIT_STATE) nuclides(t % nuclide_bins(j)) % zaid - else - write(UNIT_STATE) t % nuclide_bins(j) - end if - end do NUCLIDE_LOOP - - ! Write number of score bins, score bins, and scatt order - write(UNIT_STATE) t % n_score_bins - write(UNIT_STATE) t % score_bins - write(UNIT_STATE) t % scatt_order - - ! Write number of user score bins - write(UNIT_STATE) t % n_user_score_bins - end do TALLY_METADATA - - ! Number of realizations for global tallies - write(UNIT_STATE) n_realizations - - ! Write out global tallies sum and sum_sq - write(UNIT_STATE) N_GLOBAL_TALLIES - GLOBAL_TALLIES_LOOP: do i = 1, N_GLOBAL_TALLIES - write(UNIT_STATE) global_tallies(i) % sum - write(UNIT_STATE) global_tallies(i) % sum_sq - end do GLOBAL_TALLIES_LOOP - - if (tallies_on) then - ! Indicate that tallies are on - write(UNIT_STATE) 1 - - TALLY_RESULTS: do i = 1, n_tallies - ! Get pointer to tally - t => tallies(i) - - ! Write tally sum and sum_sq for each bin - do k = 1, size(t % results, 2) - do j = 1, size(t % results, 1) - write(UNIT_STATE) t % results(j,k) % sum - write(UNIT_STATE) t % results(j,k) % sum_sq - end do - end do - end do TALLY_RESULTS - else - ! Indicate that tallies are off - write(UNIT_STATE) 0 - end if - - ! Write out source bank - if (run_mode == MODE_EIGENVALUE) then - if (source_separate) then - ! If the user has specified that the source sites should be written in - ! a separate file, we make a call to the appropriate subroutine to - ! write it separately - - if (source_write) then - path_source = "source." // trim(to_str(current_batch)) // ".binary" - call write_source_binary() - end if - elseif (source_write) then - ! Otherwise, write the source sites in the state point file - - write(UNIT_STATE) source_bank - end if - end if - - ! Close binary state point file - close(UNIT_STATE) -#endif - end subroutine write_state_point #ifdef MPI @@ -430,179 +269,215 @@ contains #endif ! Write revision number for state point file -#ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "revision_statepoint", & - REVISION_STATEPOINT) -#else - call MPI_FILE_WRITE(fh, REVISION_STATEPOINT, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "revision_statepoint", & + REVISION_STATEPOINT) +# elif MPI + call MPI_FILE_WRITE(fh, REVISION_STATEPOINT, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) REVISION_STATEPOINT +# endif ! Write OpenMC version -#ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "version_major", VERSION_MAJOR) - call hdf5_write_integer(hdf5_state_point, "version_minor", VERSION_MINOR) - call hdf5_write_integer(hdf5_state_point, "version_release", VERSION_RELEASE) -#else - call MPI_FILE_WRITE(fh, VERSION_MAJOR, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, VERSION_MINOR, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, VERSION_RELEASE, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "version_major", & + VERSION_MAJOR) + call hdf5_write_integer(hdf5_state_point, "version_minor", & + VERSION_MINOR) + call hdf5_write_integer(hdf5_state_point, "version_release", & + VERSION_RELEASE) +# elif MPI + call MPI_FILE_WRITE(fh, VERSION_MAJOR, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, VERSION_MINOR, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, VERSION_RELEASE, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) VERSION_MAJOR, VERSION_MINOR, VERSION_RELEASE +# endif ! Write current date and time -#ifdef HDF5 - call h5ltmake_dataset_string_f(hdf5_state_point, "date_and_time", & - time_stamp(), hdf5_err) -#else - call MPI_FILE_WRITE(fh, time_stamp(), 19, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call h5ltmake_dataset_string_f(hdf5_state_point, "date_and_time", & + time_stamp(), hdf5_err) +# elif MPI + call MPI_FILE_WRITE(fh, time_stamp(), 19, MPI_CHARACTER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) time_stamp() +# endif ! Write path to input -#ifdef HDF5 - call h5ltmake_dataset_string_f(hdf5_state_point, "path", & - path_input, hdf5_err) -#else - call MPI_FILE_WRITE(fh, path_input, MAX_FILE_LEN, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call h5ltmake_dataset_string_f(hdf5_state_point, "path", & + path_input, hdf5_err) +# elif MPI + call MPI_FILE_WRITE(fh, path_input, MAX_FILE_LEN, MPI_CHARACTER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) path_input +# endif ! Write out random number seed -#ifdef HDF5 - call hdf5_write_long(hdf5_state_point, "seed", seed) -#else - call MPI_FILE_WRITE(fh, seed, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_long(hdf5_state_point, "seed", seed) +# elif MPI + call MPI_FILE_WRITE(fh, seed, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) seed +# endif ! Write run information -#ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "run_mode", run_mode) - call hdf5_write_long(hdf5_state_point, "n_particles", n_particles) - call hdf5_write_integer(hdf5_state_point, "n_batches", n_batches) -#else - call MPI_FILE_WRITE(fh, run_mode, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, n_particles, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, n_batches, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "run_mode", run_mode) + call hdf5_write_long(hdf5_state_point, "n_particles", n_particles) + call hdf5_write_integer(hdf5_state_point, "n_batches", n_batches) +# elif MPI + call MPI_FILE_WRITE(fh, run_mode, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, n_particles, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, n_batches, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) run_mode, n_particles, n_batches +# endif ! Write out current batch number -#ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "current_batch", current_batch) -#else - call MPI_FILE_WRITE(fh, current_batch, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "current_batch", & + current_batch) +# elif MPI + call MPI_FILE_WRITE(fh, current_batch, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) current_batch +# endif ! Write out information for eigenvalue run if (run_mode == MODE_EIGENVALUE) then -#ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "n_inactive", n_inactive) - call hdf5_write_integer(hdf5_state_point, "gen_per_batch", gen_per_batch) - - ! Write out keff and entropy - dims(1) = current_batch - call h5ltmake_dataset_double_f(hdf5_state_point, "k_batch", 1, & - dims, k_batch, hdf5_err) - dims(1) = current_batch*gen_per_batch - call h5ltmake_dataset_double_f(hdf5_state_point, "entropy", 1, & - dims, entropy, hdf5_err) - call hdf5_write_double(hdf5_state_point, "k_col_abs", k_col_abs) - call hdf5_write_double(hdf5_state_point, "k_col_tra", k_col_tra) - call hdf5_write_double(hdf5_state_point, "k_abs_tra", k_abs_tra) - dims(1) = 2 - call h5ltmake_dataset_double_f(hdf5_state_point, "k_combined", 1, & - dims, k_combined, hdf5_err) -#else - call MPI_FILE_WRITE(fh, n_inactive, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, gen_per_batch, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, k_batch, current_batch, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, entropy, current_batch*gen_per_batch, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, k_col_abs, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, k_col_tra, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, k_abs_tra, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, k_combined, 2, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(hdf5_state_point, "n_inactive", & + n_inactive) + call hdf5_write_integer(hdf5_state_point, "gen_per_batch", & + gen_per_batch) + dims(1) = current_batch + call h5ltmake_dataset_double_f(hdf5_state_point, "k_batch", 1, & + dims, k_batch, hdf5_err) + dims(1) = current_batch*gen_per_batch + call h5ltmake_dataset_double_f(hdf5_state_point, "entropy", 1, & + dims, entropy, hdf5_err) + call hdf5_write_double(hdf5_state_point, "k_col_abs", k_col_abs) + call hdf5_write_double(hdf5_state_point, "k_col_tra", k_col_tra) + call hdf5_write_double(hdf5_state_point, "k_abs_tra", k_abs_tra) + dims(1) = 2 + call h5ltmake_dataset_double_f(hdf5_state_point, "k_combined", 1, & + dims, k_combined, hdf5_err) +# elif MPI + call MPI_FILE_WRITE(fh, n_inactive, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, gen_per_batch, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, k_batch, current_batch, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, entropy, current_batch*gen_per_batch, & + MPI_REAL8, MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, k_col_abs, 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, k_col_tra, 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, k_abs_tra, 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, k_combined, 2, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) n_inactive, gen_per_batch + write(UNIT_STATE) k_batch(1:current_batch) + write(UNIT_STATE) entropy(1:current_batch*gen_per_batch) + write(UNIT_STATE) k_col_abs + write(UNIT_STATE) k_col_tra + write(UNIT_STATE) k_abs_tra + write(UNIT_STATE) k_combined +# endif end if - ! Write number of meshes #ifdef HDF5 + ! Create group "tallies" call h5gcreate_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) - call hdf5_write_integer(tallies_group, "n_meshes", n_meshes) -#else - call MPI_FILE_WRITE(fh, n_meshes, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) #endif + ! Write number of meshes +# ifdef HDF5 + call hdf5_write_integer(tallies_group, "n_meshes", n_meshes) +# elif MPI + call MPI_FILE_WRITE(fh, n_meshes, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) n_meshes +# endif + ! Write information for meshes MESH_LOOP: do i = 1, n_meshes -#ifdef HDF5 - ! Create temporary group for each mesh - call h5gcreate_f(tallies_group, "mesh" // to_str(i), & - temp_group, hdf5_err) +# ifdef HDF5 + ! Create temporary group for each mesh + call h5gcreate_f(tallies_group, "mesh" // to_str(i), & + temp_group, hdf5_err) - ! Write id, type, and number of dimensions - call hdf5_write_integer(temp_group, "id", meshes(i) % id) - call hdf5_write_integer(temp_group, "type", meshes(i) % type) - call hdf5_write_integer(temp_group, "n_dimension", & - meshes(i) % n_dimension) -#else - call MPI_FILE_WRITE(fh, meshes(i) % id, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, meshes(i) % type, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, meshes(i) % n_dimension, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif + call hdf5_write_integer(temp_group, "id", meshes(i) % id) + call hdf5_write_integer(temp_group, "type", meshes(i) % type) + call hdf5_write_integer(temp_group, "n_dimension", & + meshes(i) % n_dimension) + dims(1) = meshes(i) % n_dimension + call hdf5_write_array(temp_group, "dimension", & + meshes(i) % dimension, 1, dims) + call hdf5_write_array(temp_group, "lower_left", & + meshes(i) % lower_left, 1, dims) + call hdf5_write_array(temp_group, "upper_right", & + meshes(i) % upper_right, 1, dims) + call hdf5_write_array(temp_group, "width", & + meshes(i) % width, 1, dims) - ! Write mesh information -#ifdef HDF5 - dims(1) = meshes(i) % n_dimension - call hdf5_write_array(temp_group, "dimension", & - meshes(i) % dimension, 1, dims) - call hdf5_write_array(temp_group, "lower_left", & - meshes(i) % lower_left, 1, dims) - call hdf5_write_array(temp_group, "upper_right", & - meshes(i) % upper_right, 1, dims) - call hdf5_write_array(temp_group, "width", & - meshes(i) % width, 1, dims) - - ! Close temporary group for mesh - call h5gclose_f(temp_group, hdf5_err) -#else - n = meshes(i) % n_dimension - call MPI_FILE_WRITE(fh, meshes(i) % dimension, n, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, meshes(i) % lower_left, n, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, meshes(i) % upper_right, n, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, meshes(i) % width, n, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) -#endif + ! Close temporary group for mesh + call h5gclose_f(temp_group, hdf5_err) +# elif MPI + call MPI_FILE_WRITE(fh, meshes(i) % id, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, meshes(i) % type, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, meshes(i) % n_dimension, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + n = meshes(i) % n_dimension + call MPI_FILE_WRITE(fh, meshes(i) % dimension, n, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, meshes(i) % lower_left, n, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, meshes(i) % upper_right, n, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, meshes(i) % width, n, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) meshes(i) % id + write(UNIT_STATE) meshes(i) % type + write(UNIT_STATE) meshes(i) % n_dimension + write(UNIT_STATE) meshes(i) % dimension + write(UNIT_STATE) meshes(i) % lower_left + write(UNIT_STATE) meshes(i) % upper_right + write(UNIT_STATE) meshes(i) % width +# endif end do MESH_LOOP ! Write number of tallies -#ifdef HDF5 - call hdf5_write_integer(tallies_group, "n_tallies", n_tallies) -#else - call MPI_FILE_WRITE(fh, n_tallies, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(tallies_group, "n_tallies", n_tallies) +# elif MPI + call MPI_FILE_WRITE(fh, n_tallies, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) n_tallies +# endif TALLY_METADATA: do i = 1, n_tallies ! Get pointer to tally @@ -612,84 +487,110 @@ contains ! Create group for this tally call h5gcreate_f(tallies_group, "tally" // to_str(i), & temp_group, hdf5_err) +#endif ! Write id - call hdf5_write_integer(temp_group, "id", t % id) -#else - call MPI_FILE_WRITE(fh, t % id, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(temp_group, "id", t % id) +# elif MPI + call MPI_FILE_WRITE(fh, t % id, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) t % id +# endif ! Write number of realizations -#ifdef HDF5 - call hdf5_write_integer(temp_group, "n_realizations", & - t % n_realizations) -#else - call MPI_FILE_WRITE(fh, t % n_realizations, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(temp_group, "n_realizations", & + t % n_realizations) +# elif HDf5 + call MPI_FILE_WRITE(fh, t % n_realizations, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) t % n_realizations +# endif ! Write size of each tally -#ifdef HDF5 - call hdf5_write_integer(temp_group, "total_score_bins", & - t % total_score_bins) - call hdf5_write_integer(temp_group, "total_filter_bins", & - t % total_filter_bins) -#else - call MPI_FILE_WRITE(fh, t % total_score_bins, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, t % total_filter_bins, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(temp_group, "total_score_bins", & + t % total_score_bins) + call hdf5_write_integer(temp_group, "total_filter_bins", & + t % total_filter_bins) +# elif MPI + call MPI_FILE_WRITE(fh, t % total_score_bins, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, t % total_filter_bins, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) t % total_score_bins + write(UNIT_STATE) t % total_filter_bins +# endif ! Write number of filters -#ifdef HDF5 - call hdf5_write_integer(temp_group, "n_filters", t % n_filters) -#else - call MPI_FILE_WRITE(fh, t % n_filters, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(temp_group, "n_filters", t % n_filters) +# elif MPI + call MPI_FILE_WRITE(fh, t % n_filters, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) t % n_filters +# endif FILTER_LOOP: do j = 1, t % n_filters - ! Write type of filter #ifdef HDF5 + ! Create filter group call h5gcreate_f(temp_group, "filter" // to_str(j), filter_group, & hdf5_err) -#else - call MPI_FILE_WRITE(fh, t % filters(j) % type, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) #endif + ! Write type of filter +# ifdef HDF5 + call hdf5_write_integer(filter_group, "type", & + t % filters(j) % type) +# elif MPI + call MPI_FILE_WRITE(fh, t % filters(j) % type, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) t % filters(j) % type +# endif + ! Write number of bins for this filter -#ifdef HDF5 - call hdf5_write_integer(filter_group, "type", t % filters(j) % type) -#else - call MPI_FILE_WRITE(fh, t % filters(j) % n_bins, & - 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(filter_group, "n_bins", & + t % filters(j) % n_bins) +# elif MPI + call MPI_FILE_WRITE(fh, t % filters(j) % n_bins, & + 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) t % filters(j) % n_bins +# endif ! Write bins if (t % filters(j) % type == FILTER_ENERGYIN .or. & t % filters(j) % type == FILTER_ENERGYOUT) then -#ifdef HDF5 - dims(1) = size(t % filters(j) % real_bins) - call h5ltmake_dataset_double_f(filter_group, "bins", 1, & - dims, t % filters(j) % real_bins, hdf5_err) -#else - n = size(t % filters(j) % real_bins) - call MPI_FILE_WRITE(fh, t % filters(j) % real_bins, n, & - MPI_REAL8, MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + dims(1) = size(t % filters(j) % real_bins) + call h5ltmake_dataset_double_f(filter_group, "bins", 1, & + dims, t % filters(j) % real_bins, hdf5_err) +# elif MPI + n = size(t % filters(j) % real_bins) + call MPI_FILE_WRITE(fh, t % filters(j) % real_bins, n, & + MPI_REAL8, MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) t % filters(j) % real_bins +# endif else -#ifdef HDF5 - dims(1) = size(t % filters(j) % int_bins) - call h5ltmake_dataset_int_f(filter_group, "bins", 1, & - dims, t % filters(j) % int_bins, hdf5_err) -#else - n = size(t % filters(j) % int_bins) - call MPI_FILE_WRITE(fh, t % filters(j) % int_bins, n, & - MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + dims(1) = size(t % filters(j) % int_bins) + call h5ltmake_dataset_int_f(filter_group, "bins", 1, & + dims, t % filters(j) % int_bins, hdf5_err) +# elif MPI + n = size(t % filters(j) % int_bins) + call MPI_FILE_WRITE(fh, t % filters(j) % int_bins, n, & + MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) t % filters(j) % int_bins +# endif end if #ifdef HDF5 @@ -727,33 +628,41 @@ contains end do FILTER_LOOP ! Write number of nuclide bins +# ifdef HDF5 + call hdf5_write_integer(temp_group, "n_nuclide_bins", & + t % n_nuclide_bins) +# elif MPI + call MPI_FILE_WRITE(fh, t % n_nuclide_bins, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) t % n_nuclide_bins +# endif + #ifdef HDF5 - call hdf5_write_integer(temp_group, "n_nuclide_bins", & - t % n_nuclide_bins) -#else - call MPI_FILE_WRITE(fh, t % n_nuclide_bins, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) + ! Allocate array for HDf5 + allocate(temp_array(t % n_nuclide_bins)) #endif ! Write nuclide bins -#ifdef HDF5 - allocate(temp_array(t % n_nuclide_bins)) -#endif NUCLIDE_LOOP: do j = 1, t % n_nuclide_bins if (t % nuclide_bins(j) > 0) then -#ifdef HDF5 - temp_array(j) = nuclides(t % nuclide_bins(j)) % zaid -#else - call MPI_FILE_WRITE(fh, nuclides(t % nuclide_bins(j)) % zaid, & - 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + temp_array(j) = nuclides(t % nuclide_bins(j)) % zaid +# elif MPI + call MPI_FILE_WRITE(fh, nuclides(t % nuclide_bins(j)) % zaid, & + 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) nuclides(t % nuclide_bins(j)) % zaid +# endif else -#ifdef HDF5 - temp_array(j) = t % nuclide_bins(j) -#else - call MPI_FILE_WRITE(fh, t % nuclide_bins(j), 1, & - MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + temp_array(j) = t % nuclide_bins(j) +# elif MPI + call MPI_FILE_WRITE(fh, t % nuclide_bins(j), 1, & + MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) t % nuclide_bins(j) +# endif end if end do NUCLIDE_LOOP @@ -766,31 +675,37 @@ contains #endif ! Write number of score bins, score bins, and scatt order -#ifdef HDF5 - call hdf5_write_integer(temp_group, "n_score_bins", & - t % n_score_bins) - dims(1) = t % n_score_bins - call h5ltmake_dataset_int_f(temp_group, "score_bins", 1, & - dims, t % score_bins, hdf5_err) - call h5ltmake_dataset_int_f(temp_group, "scatt_order", 1, & - dims, t % scatt_order, hdf5_err) -#else - call MPI_FILE_WRITE(fh, t % n_score_bins, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, t % score_bins, t % n_score_bins, & - MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, t % scatt_order, t % n_score_bins, & - MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(temp_group, "n_score_bins", & + t % n_score_bins) + dims(1) = t % n_score_bins + call h5ltmake_dataset_int_f(temp_group, "score_bins", 1, & + dims, t % score_bins, hdf5_err) + call h5ltmake_dataset_int_f(temp_group, "scatt_order", 1, & + dims, t % scatt_order, hdf5_err) +# elif MPI + call MPI_FILE_WRITE(fh, t % n_score_bins, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, t % score_bins, t % n_score_bins, & + MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_WRITE(fh, t % scatt_order, t % n_score_bins, & + MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) t % n_score_bins + write(UNIT_STATE) t % score_bins + write(UNIT_STATE) t % scatt_order +# endif ! Write number of user score bins -#ifdef HDF5 - call hdf5_write_integer(temp_group, "n_user_score_bins", & - t % n_user_score_bins) -#else - call MPI_FILE_WRITE(fh, t % n_user_score_bins, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_write_integer(temp_group, "n_user_score_bins", & + t % n_user_score_bins) +# elif MPI + call MPI_FILE_WRITE(fh, t % n_user_score_bins, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + write(UNIT_STATE) t % n_user_score_bins +# endif #ifdef HDF5 ! Close tally group @@ -1603,15 +1518,22 @@ contains end subroutine replay_batch_history !=============================================================================== -! WRITE_SOURCE writes out the final source distribution to a binary file that -! can be used as a starting source in a new simulation +! WRITE_SOURCE writes out the final source distribution to a binary or HDF5 +! file that can be used as a starting source in a new simulation !=============================================================================== - subroutine write_source_binary() +#ifdef HDF5 + subroutine write_source() +#elif MPI + subroutine write_source(fh) +#else + subroutine write_source() +#endif #ifdef MPI - integer :: fh ! file handle - integer(MPI_OFFSET_KIND) :: offset ! offset in memory (0=beginning of file) + integer :: fh ! file handle + integer(MPI_OFFSET_KIND) :: offset ! offset in memory +#ifdef HDF5 integer(HID_T) :: hdf5_source integer(HSIZE_T) :: dims(1) integer(HID_T) :: filespace @@ -1620,81 +1542,98 @@ contains integer(HID_T) :: dset_id integer(HID_T) :: plist_id type(c_ptr) :: f_ptr - - ! ========================================================================== - ! PARALLEL I/O USING MPI-2 ROUTINES - - ! Open binary source file for writing -#ifdef HDF5 -! call hdf5_parallel_file_create(trim(path_source), hdf5_source, hdf5_plist) -#else - call MPI_FILE_OPEN(MPI_COMM_WORLD, path_source, MPI_MODE_CREATE + & - MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpi_err) +#endif #endif -#ifdef HDF5 - call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) - call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) - call h5fcreate_f(trim(path_source), H5F_ACC_TRUNC_F, hdf5_source, hdf5_err, access_prp=plist_id) - call h5pclose_f(plist_id, hdf5_err) - dims(1) = n_particles - call h5screate_simple_f(1, dims, filespace, hdf5_err) - call h5dcreate_f(hdf5_source, dsetname, hdf5_bank_t, filespace, dset_id, hdf5_err) - call h5sclose_f(filespace, hdf5_err) - call h5screate_simple_f(1, (/work/), memspace, hdf5_err) - call h5dget_space_f(dset_id, filespace, hdf5_err) - call h5sselect_hyperslab_f(filespace, H5S_SELECT_SET_F, (/bank_first-1/), (/work/), hdf5_err) - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdf5_err) - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - f_ptr = c_loc(source_bank(1)) - call h5dwrite_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err, file_space_id = filespace, mem_space_id = memspace, & - xfer_prp = plist_id) - call h5sclose_f(filespace, hdf5_err) - call h5sclose_f(memspace, hdf5_err) - call h5dclose_f(dset_id, hdf5_err) - call h5pclose_f(plist_id, hdf5_err) - call h5fclose_f(hdf5_source, hdf5_err) -#else - if (master) then - offset = 0 - call MPI_FILE_WRITE_AT(fh, offset, n_particles, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) +#ifdef MPI +# ifdef HDF5 + ! Parallel HDF5 must be written out separately + source_separate = .true. +# endif +#endif + + ! Check if source separate + if (source_separate) then +# ifdef MPI +# ifdef HDF5 + if (master) call h5fclose_f(hdf5_state_point, hdf5_err) + call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) + call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, & + hdf5_err) + call h5fcreate_f(trim(path_source), H5F_ACC_TRUNC_F, & + hdf5_source, hdf5_err, access_prp=plist_id) + call h5pclose_f(plist_id, hdf5_err) + dims(1) = n_particles + call h5screate_simple_f(1, dims, filespace, hdf5_err) + call h5dcreate_f(hdf5_source, dsetname, hdf5_bank_t, filespace, & + dset_id, hdf5_err) + call h5sclose_f(filespace, hdf5_err) + call h5screate_simple_f(1, (/work/), memspace, hdf5_err) + call h5dget_space_f(dset_id, filespace, hdf5_err) + call h5sselect_hyperslab_f(filespace, H5S_SELECT_SET_F, & + (/bank_first-1/), (/work/), hdf5_err) + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdf5_err) + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + f_ptr = c_loc(source_bank(1)) + call h5dwrite_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err, & + file_space_id = filespace, mem_space_id = memspace, & + xfer_prp = plist_id) + call h5sclose_f(filespace, hdf5_err) + call h5sclose_f(memspace, hdf5_err) + call h5dclose_f(dset_id, hdf5_err) + call h5pclose_f(plist_id, hdf5_err) + call h5fclose_f(hdf5_source, hdf5_err) +# else + call MPI_FILE_CLOSE(fh, mpi_err) + call MPI_FILE_OPEN(MPI_COMM_WORLD, path_source, MPI_MODE_CREATE + & + MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpi_err) + if (master) then + offset = 0 + call MPI_FILE_WRITE_AT(fh, offset, n_particles, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpi_err) + end if + + ! Set proper offset for source data on this processor + offset = 8*(1 + rank*maxwork*8) + + ! Write all source sites + call MPI_FILE_WRITE_AT(fh, offset, source_bank(1), work, MPI_BANK, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_CLOSE(fh, mpi_err) +# endif +# else + ! Open binary source file for writing + open(UNIT=UNIT_SOURCE, FILE=path_source, STATUS='replace', & + ACCESS='stream') + + ! Write the number of particles + write(UNIT=UNIT_SOURCE) n_particles + + ! Write information from the source bank + write(UNIT=UNIT_SOURCE) source_bank(1:work) + + ! Close binary source file + close(UNIT=UNIT_SOURCE) +# endif + + ! append source to statepoint file + else +# ifdef HDF5 + dims(1) = work + call h5screate_simple_f(1, dims, filespace, hdf5_err) + call h5dcreate_f(hdf5_state_point, "source_bank", hdf5_bank_t, & + filespace, dset_id, hdf5_err) + f_ptr = c_loc(source_bank(1)) + call h5dwrite_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err) + call h5dclose_f(dset_id, hdf5_err) + call h5sclose_f(filespace, hdf5_err) +# else + write(UNIT_STATE) source_bank +# endif + end if - ! Set proper offset for source data on this processor - offset = 8*(1 + rank*maxwork*8) - - ! Write all source sites - call MPI_FILE_WRITE_AT(fh, offset, source_bank(1), work, MPI_BANK, & - MPI_STATUS_IGNORE, mpi_err) -#endif - - ! Close binary source file -#ifdef HDF5 -! call hdf5_parallel_file_close(hdf5_source, hdf5_plist) -#else - call MPI_FILE_CLOSE(fh, mpi_err) -#endif - -#else - ! ========================================================================== - ! SERIAL I/O USING FORTRAN INTRINSIC ROUTINES - - ! Open binary source file for writing - open(UNIT=UNIT_SOURCE, FILE=path_source, STATUS='replace', & - ACCESS='stream') - - ! Write the number of particles - write(UNIT=UNIT_SOURCE) n_particles - - ! Write information from the source bank - write(UNIT=UNIT_SOURCE) source_bank(1:work) - - ! Close binary source file - close(UNIT=UNIT_SOURCE) -#endif - - end subroutine write_source_binary + end subroutine write_source !=============================================================================== ! READ_SOURCE_BINARY reads a source distribution from a source.binary file and From 5316f6da3da1a2b4ecb7adb783adb504aee8b65c Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 9 May 2013 18:14:44 -0400 Subject: [PATCH 07/65] changed reading statepoint routines --- src/source.F90 | 4 +- src/state_point.F90 | 1091 +++++++++++++++++++++---------------------- 2 files changed, 539 insertions(+), 556 deletions(-) diff --git a/src/source.F90 b/src/source.F90 index 4075422366..d0baeeb706 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -9,7 +9,7 @@ module source use particle_header, only: deallocate_coord use physics, only: maxwell_spectrum, watt_spectrum use random_lcg, only: prn, set_particle_seed - use state_point, only: read_source_binary + use state_point, only: read_source use string, only: to_str #ifdef MPI @@ -38,7 +38,7 @@ contains ! Read the source from a binary file instead of sampling from some ! assumed source distribution - call read_source_binary() + call read_source() else ! Generation source sites from specified distribution in user input diff --git a/src/state_point.F90 b/src/state_point.F90 index ae5b2d3ab6..030fefcffc 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -846,9 +846,9 @@ contains subroutine load_state_point() - integer :: i, j ! loop indices - integer :: mode ! specified run mode - integer :: temp(3) ! temporary variable + integer :: i, j ! loop indices + integer :: mode ! specified run mode + integer :: temp(3) ! temporary variable integer, allocatable :: int_array(:) real(8), allocatable :: real_array(:) character(19) :: current_time ! current date and time @@ -869,6 +869,7 @@ contains integer(HID_T) :: tally_group ! identifier for tally group integer(HID_T) :: tallies_group integer(HID_T) :: temp_group + integer(HID_T) :: filter_group integer(HID_T) :: dset ! identifier for dataset integer(HSIZE_T) :: dims(1) ! dimensions of 1D arrays integer(HID_T) :: hdf5_source @@ -885,26 +886,31 @@ contains message = "Loading state point " // trim(path_state_point) // "..." call write_message(1) -#ifdef MPI ! Open binary state point file for reading -#ifdef HDF5 - call h5fopen_f(path_state_point, H5F_ACC_RDONLY_F, & - hdf5_state_point, hdf5_err) -#else - call MPI_FILE_OPEN(MPI_COMM_WORLD, path_state_point, MPI_MODE_RDONLY, & - MPI_INFO_NULL, fh, mpi_err) -#endif +# ifdef HDF5 + call h5fopen_f(path_state_point, H5F_ACC_RDONLY_F, & + hdf5_state_point, hdf5_err) +# elif MPI + call MPI_FILE_OPEN(MPI_COMM_WORLD, path_state_point, MPI_MODE_RDONLY, & + MPI_INFO_NULL, fh, mpi_err) +# else + open(UNIT=UNIT_STATE, FILE=path_state_point, STATUS='old', & + ACCESS='stream') +# endif ! ========================================================================== ! RUN INFORMATION AND TALLY METADATA - ! Raad revision number for state point file and make sure it matches with + ! Read revision number for state point file and make sure it matches with ! current version -#ifdef HDF5 - call hdf5_read_integer(hdf5_state_point, "revision_statepoint", temp(1)) -#else - call MPI_FILE_READ_ALL(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_read_integer(hdf5_state_point, "revision_statepoint", temp(1)) +# elif MPI + call MPI_FILE_READ_ALL(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, & + mpi_err) +# else + read(UNIT_STATE) temp(1) +# endif if (temp(1) /= REVISION_STATEPOINT) then message = "State point binary version does not match current version " & // "in OpenMC." @@ -912,176 +918,236 @@ contains end if ! Read OpenMC version -#ifdef HDF5 -! call hdf5_read_integer(hdf5_state_point, "version_major", temp(1)) -! call hdf5_read_integer(hdf5_state_point, "version_minor", temp(2)) -! call hdf5_read_integer(hdf5_state_point, "version_release", temp(3)) -#else - call MPI_FILE_READ_ALL(fh, temp, 3, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + call hdf5_read_integer(hdf5_state_point, "version_major", temp(1)) + call hdf5_read_integer(hdf5_state_point, "version_minor", temp(2)) + call hdf5_read_integer(hdf5_state_point, "version_release", temp(3)) +# elif MPI + call MPI_FILE_READ_ALL(fh, temp, 3, MPI_INTEGER, MPI_STATUS_IGNORE, & + mpi_err) +# else + read(UNIT_STATE) temp(1:3) +# endif if (temp(1) /= VERSION_MAJOR .or. temp(2) /= VERSION_MINOR & .or. temp(3) /= VERSION_RELEASE) then message = "State point file was created with a different version " // & "of OpenMC." call warning() end if -#endif ! Read date and time -#ifndef HDF5 - call MPI_FILE_READ_ALL(fh, current_time, 19, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call h5ltread_dataset_string_f(hdf5_state_point, "date_and_time", & + current_time, hdf5_err) ! TODO check this +# elif MPI + call MPI_FILE_READ_ALL(fh, current_time, 19, MPI_CHARACTER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) current_time +# endif ! Read path to input -#ifndef HDF5 - call MPI_FILE_READ_ALL(fh, path_temp, MAX_FILE_LEN, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call h5ltread_dataset_string_f(hdf5_state_point, "path", & + path_temp, hdf5_err) +# elif MPI + call MPI_FILE_READ_ALL(fh, path_temp, MAX_FILE_LEN, MPI_CHARACTER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) path_temp +# endif ! Read and overwrite random number seed -#ifdef HDF5 - call hdf5_read_long(hdf5_state_point, "seed", seed) -#else - call MPI_FILE_READ_ALL(fh, seed, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_read_long(hdf5_state_point, "seed", seed) +# elif MPI + call MPI_FILE_READ_ALL(fh, seed, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) seed +# endif - ! Read and overwrite run information -#ifdef HDF5 - call hdf5_read_integer(hdf5_state_point, "run_mode", mode) - call hdf5_read_long(hdf5_state_point, "n_particles", n_particles) - call hdf5_read_integer(hdf5_state_point, "n_batches", n_batches) -#else - call MPI_FILE_READ_ALL(fh, mode, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, n_particles, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, n_batches, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif + ! Read and overwrite run information except for n_batches +# ifdef HDF5 + call hdf5_read_integer(hdf5_state_point, "run_mode", mode) + call hdf5_read_long(hdf5_state_point, "n_particles", n_particles) + call hdf5_read_integer(hdf5_state_point, "n_batches", temp(1)) +# elif MPI + call MPI_FILE_READ_ALL(fh, mode, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_READ_ALL(fh, n_particles, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_READ_ALL(fh, temp(1), 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) mode, n_particles, temp(1) +# endif + + ! Allow user to specify more than n_batches + n_batches = max(n_batches, temp(1)) ! Read batch number to restart at -#ifdef HDF5 - call hdf5_read_integer(hdf5_state_point, "current_batch", restart_batch) -#else - call MPI_FILE_READ_ALL(fh, restart_batch, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_read_integer(hdf5_state_point, "current_batch", restart_batch) +# elif MPI + call MPI_FILE_READ_ALL(fh, restart_batch, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) restart_batch +# endif ! Read information specific to eigenvalue run if (mode == MODE_EIGENVALUE) then -#ifdef HDF5 - call hdf5_read_integer(hdf5_state_point, "n_inactive", n_inactive) - call hdf5_read_integer(hdf5_state_point, "gen_per_batch", gen_per_batch) - dims(1) = restart_batch - call h5ltread_dataset_double_f(hdf5_state_point, "k_batch", & - k_batch(1:restart_batch), dims, hdf5_err) - dims(1) = restart_batch*gen_per_batch - call h5ltread_dataset_double_f(hdf5_state_point, "entropy", & - entropy(1:restart_batch*gen_per_batch), dims, hdf5_err) - call hdf5_read_double(hdf5_state_point, "k_col_abs", k_col_abs) - call hdf5_read_double(hdf5_state_point, "k_col_tra", k_col_tra) - call hdf5_read_double(hdf5_state_point, "k_abs_tra", k_abs_tra) -#else - call MPI_FILE_READ_ALL(fh, n_inactive, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, gen_per_batch, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, k_batch, restart_batch, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, entropy, restart_batch*gen_per_batch, & - MPI_REAL8, MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, k_col_abs, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, k_col_tra, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, k_abs_tra, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - allocate(real_array(2)) - call MPI_FILE_READ_ALL(fh, real_array, 2, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - deallocate(real_array) -#endif - end if +# ifdef HDF5 + call hdf5_read_integer(hdf5_state_point, "n_inactive", temp(1)) + call hdf5_read_integer(hdf5_state_point, "gen_per_batch", & + gen_per_batch) + dims(1) = restart_batch + call h5ltread_dataset_double_f(hdf5_state_point, "k_batch", & + k_batch(1:restart_batch), dims, hdf5_err) + dims(1) = restart_batch*gen_per_batch + call h5ltread_dataset_double_f(hdf5_state_point, "entropy", & + entropy(1:restart_batch*gen_per_batch), dims, hdf5_err) + call hdf5_read_double(hdf5_state_point, "k_col_abs", k_col_abs) + call hdf5_read_double(hdf5_state_point, "k_col_tra", k_col_tra) + call hdf5_read_double(hdf5_state_point, "k_abs_tra", k_abs_tra) + ! not reading in k-combined because below code doesnt +# elif MPI + call MPI_FILE_READ_ALL(fh, temp(1), 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_READ_ALL(fh, gen_per_batch, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_READ_ALL(fh, k_batch, restart_batch, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_READ_ALL(fh, entropy, restart_batch*gen_per_batch, & + MPI_REAL8, MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_READ_ALL(fh, k_col_abs, 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_READ_ALL(fh, k_col_tra, 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_READ_ALL(fh, k_abs_tra, 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + allocate(real_array(2)) + call MPI_FILE_READ_ALL(fh, real_array, 2, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + deallocate(real_array) +# else + read(UNIT_STATE) temp(1), gen_per_batch + read(UNIT_STATE) k_batch(1:restart_batch) + read(UNIT_STATE) entropy(1:restart_batch*gen_per_batch) + read(UNIT_STATE) k_col_abs + read(UNIT_STATE) k_col_tra + read(UNIT_STATE) k_abs_tra + allocate(real_array(2)) + read(UNIT_STATE) real_array + deallocate(real_array) +# endif -#ifdef HDF5 - call hdf5_read_integer(hdf5_state_point, "n_realizations", n_realizations) -#endif + ! Allow user to modify n_inactive + n_inactive = max(n_inactive, temp(1)) + + end if if (master) then ! Read number of meshes -#ifdef HDF5 -! call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) -! call hdf5_read_integer(tallies_group, "n_meshes", temp(1)) -#else - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) ! TODO Close group + call hdf5_read_integer(tallies_group, "n_meshes", temp(1)) +# elif MPI + call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, & + mpi_err) +# else + read(UNIT_STATE) temp(1) +# endif if (temp(1) /= n_meshes) then message = "Number of meshes does not match in state point." call fatal_error() end if -#endif + MESH_LOOP: do i = 1, n_meshes ! Read id, mesh type, and dimension -#ifdef HDF5 - ! Create temporary group for each mesh -! call h5gcreate_f(tallies_group, "mesh" // to_str(i), & -! temp_group, hdf5_err) +# ifdef HDF5 + ! Nothing performed for HDF5, skip reading of mesh +# elif MPI + call MPI_FILE_READ(fh, temp, 3, MPI_INTEGER, MPI_STATUS_IGNORE, & + mpi_err) - ! Write id, type, and number of dimensions -! call hdf5_write_integer(temp_group, "id", meshes(i) % id) -! call hdf5_write_integer(temp_group, "type", meshes(i) % type) -! call hdf5_write_integer(temp_group, "n_dimension", & -! meshes(i) % n_dimension) + ! Skip mesh data + call MPI_FILE_GET_POSITION(fh, offset, mpi_err) + offset = offset + temp(3)*(4 + 3*8) + call MPI_FILE_SEEK(fh, offset, MPI_SEEK_SET, mpi_err) +# else + ! Read id, mesh type, and dimension + read(UNIT_STATE) temp(1:3) - ! Write mesh information -! dims(1) = meshes(i) % n_dimension -! call h5ltmake_dataset_int_f(temp_group, "dimension", 1, & -! dims, meshes(i) % dimension, hdf5_err) -! call h5ltmake_dataset_double_f(temp_group, "lower_left", 1, & -! dims, meshes(i) % lower_left, hdf5_err) -! call h5ltmake_dataset_double_f(temp_group, "upper_right", 1, & -! dims, meshes(i) % upper_right, hdf5_err) -! call h5ltmake_dataset_double_f(temp_group, "width", 1, & -! dims, meshes(i) % width, hdf5_err) + ! Allocate temporary arrays + allocate(int_array(temp(3))) + allocate(real_array(temp(3))) - ! Close temporary group for mesh -! call h5gclose_f(temp_group, hdf5_err) -#else - call MPI_FILE_READ(fh, temp, 3, MPI_INTEGER, MPI_STATUS_IGNORE, & - mpi_err) + ! Read dimension, lower_left, upper_right, width + read(UNIT_STATE) int_array + read(UNIT_STATE) real_array + read(UNIT_STATE) real_array + read(UNIT_STATE) real_array - ! Skip mesh data - call MPI_FILE_GET_POSITION(fh, offset, mpi_err) - offset = offset + temp(3)*(4 + 3*8) - call MPI_FILE_SEEK(fh, offset, MPI_SEEK_SET, mpi_err) -#endif + ! Deallocate temporary arrays + deallocate(int_array) + deallocate(real_array) +# endif end do MESH_LOOP ! Read number of tallies and make sure it matches -#ifdef HDF5 -! call hdf5_write_integer(tallies_group, "n_tallies", temp(1)) -#else - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + call hdf5_write_integer(tallies_group, "n_tallies", temp(1)) +# elif MPI + call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, & + mpi_err) +# else + read(UNIT_STATE) temp(1) +# endif if (temp(1) /= n_tallies) then message = "Number of tallies does not match in state point." call fatal_error() end if -#endif -#ifndef HDF5 + TALLY_METADATA: do i = 1, n_tallies ! Read tally id - call MPI_FILE_READ(fh, tallies(i) % id, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + call h5gopen_f(tallies_group, "tally" // to_str(i), & + temp_group, hdf5_err) + call hdf5_read_integer(temp_group, "id", tallies(i) % id) +# elif MPI + call MPI_FILE_READ(fh, tallies(i) % id, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) tallies(i) % id +# endif - ! Read number of realizations for global tallies - call MPI_FILE_READ(fh, tallies(i) % n_realizations, 1, & - MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) + ! Read number of realizations for tallies +# ifdef HDF5 + call hdf5_read_integer(temp_group, "n_realizations", & + tallies(i) % n_realizations) +# elif MPI + call MPI_FILE_READ(fh, tallies(i) % n_realizations, 1, & + MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) tallies(i) % n_realizations +# endif ! Read dimensions of tally filters and results and make sure they ! match - call MPI_FILE_READ(fh, temp, 2, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + call hdf5_read_integer(temp_group, "total_score_bins", & + temp(1)) + call hdf5_read_integer(temp_group, "total_filter_bins", & + temp(2)) +# elif MPI + call MPI_FILE_READ(fh, temp, 2, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) temp(1:2) +# endif if (temp(1) /= size(tallies(i) % results, 1) .or. & temp(2) /= size(tallies(i) % results, 2)) then message = "Tally dimensions do not match in state point." @@ -1089,98 +1155,199 @@ contains end if ! Read number of filters - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + call hdf5_read_integer(temp_group, "n_filters", temp(1)) +# elif MPI + call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) temp(1) +# endif +call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) +call MPI_ABORT(MPI_COMM_WORLD, -8, mpi_err) FILTER_LOOP: do j = 1, temp(1) +#ifdef HDF5 + ! Open up the filter group + call h5gopen_f(temp_group, "filter" // to_str(j), filter_group, & + hdf5_err) +#endif + ! Read filter type and number of bins - call MPI_FILE_READ(fh, temp(2), 2, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + call hdf5_read_integer(filter_group, "type", temp(2)) + call hdf5_read_integer(filter_group, "n_bins", temp(3)) +# elif MPI + call MPI_FILE_READ(fh, temp(2), 2, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) temp(2:3) +# endif ! Read filter bins select case (temp(2)) case (FILTER_MESH) allocate(int_array(1)) - call MPI_FILE_READ(fh, int_array, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + ! Skip HDF5 reading of this +# elif MPI + call MPI_FILE_READ(fh, int_array, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) int_array +# endif deallocate(int_array) case (FILTER_ENERGYIN, FILTER_ENERGYOUT) allocate(real_array(temp(3) + 1)) - call MPI_FILE_READ(fh, real_array, temp(3) + 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + ! Skip HDF5 reading of this +# elif MPI + call MPI_FILE_READ(fh, real_array, temp(3) + 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) real_array +# endif deallocate(real_array) case default allocate(int_array(temp(3))) - call MPI_FILE_READ(fh, int_array, temp(3), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + ! Skip HDF5 reading of this +# elif MPI + call MPI_FILE_READ(fh, int_array, temp(3), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) int_array +# endif deallocate(int_array) end select + +#ifdef HDF5 + ! Close the filter group + call h5gclose_f(filter_group, hdf5_err) +#endif + end do FILTER_LOOP ! Read number of nuclides - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + call hdf5_write_integer(temp_group, "n_nuclide_bins", & + tallies(i) % n_nuclide_bins) +# elif MPI + call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) temp(1) +# endif ! Read nuclide bins allocate(int_array(temp(1))) - call MPI_FILE_READ(fh, int_array, temp(1), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + ! Skip HDF5 for reading this +# elif MPI + call MPI_FILE_READ(fh, int_array, temp(1), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) int_array +# endif deallocate(int_array) ! Read number of score bins, score bins, and scatt_order - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + ! Skip HDF5 for reading this +# elif MPI + call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) temp(1) +# endif allocate(int_array(temp(1))) - call MPI_FILE_READ(fh, int_array, temp(1), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ(fh, int_array, temp(1), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + ! Skip HDF5 for reading this +# elif MPI + call MPI_FILE_READ(fh, int_array, temp(1), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + call MPI_FILE_READ(fh, int_array, temp(1), MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) int_array + read(UNIT_STATE) int_array +# endif deallocate(int_array) ! Read number of user score bins - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - end do TALLY_METADATA +# ifdef HDF5 + call hdf5_read_integer(temp_group, "n_user_score_bins", temp(1)) +# elif MPI + call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) temp(1) +# endif + +#ifdef HDF5 + ! Close HDF5 temp group + call h5gclose_f(temp_group, hdf5_err) #endif + end do TALLY_METADATA ! Read number of realizations for global tallies -#ifdef HDF5 -! call hdf5_read_integer(hdf5_state_point, "n_realizations", n_realizations) -#else - call MPI_FILE_READ(fh, n_realizations, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + call hdf5_read_integer(hdf5_state_point, "n_realizations", & + n_realizations) +# elif MPI + call MPI_FILE_READ(fh, n_realizations, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT_STATE) n_realizations +# endif ! Read number of global tallies and make sure it matches - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) +# ifdef HDF5 + call hdf5_read_integer(hdf5_state_point, "n_global_tallies", & + temp(1)) +# elif MPI + call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, & + mpi_err) +# else + read(UNIT_STATE) temp(1) +# endif if (temp(1) /= N_GLOBAL_TALLIES) then message = "Number of global tallies does not match in state point." call fatal_error() end if -#endif +!call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) +!call MPI_ABORT(MPI_COMM_WORLD, -5, mpi_err) ! Read global tally data -#ifdef HDF5 - ! Open global tallies dataset - call h5dopen_f(hdf5_state_point, "global_tallies", dset, hdf5_err) +# ifdef HDF5 + ! Open global tallies dataset + call h5dopen_f(hdf5_state_point, "global_tallies", dset, hdf5_err) - ! Read global tallies - f_ptr = c_loc(global_tallies(1)) - call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + ! Read global tallies + f_ptr = c_loc(global_tallies(1)) + call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + + ! Close global tallies dataset + call h5dclose_f(dset, hdf5_err) +# elif MPI + call MPI_FILE_READ(fh, global_tallies, N_GLOBAL_TALLIES, & + MPI_TALLYRESULT, MPI_STATUS_IGNORE, mpi_err) +# else + do i = 1, N_GLOBAL_TALLIES + read(UNIT_STATE) global_tallies(i) % sum + read(UNIT_STATE) global_tallies(i) % sum_sq + end do +# endif - ! Close global tallies dataset - call h5dclose_f(dset, hdf5_err) -#else - call MPI_FILE_READ(fh, global_tallies, N_GLOBAL_TALLIES, & - MPI_TALLYRESULT, MPI_STATUS_IGNORE, mpi_err) -#endif ! Check if tally results are present -#ifdef HDF5 - call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) - call hdf5_read_integer(tallies_group, "tallies_present", temp(1)) - call h5gclose_f(tallies_group, hdf5_err) -#else - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -#endif +# ifdef HDF5 + call hdf5_read_integer(tallies_group, "tallies_present", temp(1)) +# elif MPI + call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, & + mpi_err) +# else + read(UNIT_STATE) temp(1) +# endif ! ======================================================================= ! TALLY RESULTS @@ -1188,278 +1355,62 @@ contains ! Read sum and sum squared if (temp(1) == 1) then TALLY_RESULTS: do i = 1, n_tallies -#ifdef HDF5 - ! Open tally group - call h5gopen_f(hdf5_state_point, "tallies/tally" // & - to_str(i), tally_group, hdf5_err) +# ifdef HDF5 + ! Open tally group + call h5gopen_f(tallies_group, "tally" // to_str(i), tally_group, & + hdf5_err) - ! Read number of realizations - call hdf5_read_integer(tally_group, "n_realizations", & - tallies(i) % n_realizations) + ! Read number of realizations + call hdf5_read_integer(tally_group, "n_realizations", & + tallies(i) % n_realizations) - ! Open dataset for tally results - call h5dopen_f(tally_group, "results", dset, hdf5_err) + ! Open dataset for tally results + call h5dopen_f(tally_group, "results", dset, hdf5_err) - ! Read sum and sum_sq for each tally bin - f_ptr = c_loc(tallies(i) % results(1,1)) - call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + ! Read sum and sum_sq for each tally bin + f_ptr = c_loc(tallies(i) % results(1,1)) + call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) - ! Close dataset for tally results - call h5dclose_f(dset, hdf5_err) + ! Close dataset for tally results + call h5dclose_f(dset, hdf5_err) - ! Close tally group - call h5gclose_f(tally_group, hdf5_err) -#else - n = size(tallies(i) % results, 1) * size(tallies(i) % results, 2) - call MPI_FILE_READ(fh, tallies(i) % results, n, MPI_TALLYRESULT, & - MPI_STATUS_IGNORE, mpi_err) -#endif - end do TALLY_RESULTS - end if - end if - -#ifdef HDF5 - call h5fclose_f(hdf5_state_point, mpi_err) - print *,'HDERE' -#endif - - ! ========================================================================== - ! SOURCE BANK - - if (run_mode == MODE_EIGENVALUE) then -#ifdef HDF5 - print *,'CURRENT BATCH',rank,restart_batch - path_source = "source." // trim(to_str(restart_batch)) // ".h5" -! call h5pclose_f(hdf5_plist, hdf5_err) - call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) - call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) - call h5fopen_f(trim(path_source), H5F_ACC_RDONLY_F, hdf5_source, hdf5_err, access_prp=plist_id) - call h5pclose_f(plist_id, hdf5_err) - call h5dopen_f(hdf5_source, dsetname, dset_id, hdf5_err) - call h5dget_space_f(dset_id, filespace, hdf5_err) - call h5sselect_hyperslab_f(filespace, H5S_SELECT_SET_F, (/bank_first-1/), (/work/), hdf5_err) - call h5screate_simple_f(1, (/work/), memspace, hdf5_err) - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdf5_err) - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - f_ptr = c_loc(source_bank(1)) - call h5dread_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err, file_space_id = filespace, mem_space_id = memspace, xfer_prp = plist_id) - call h5sclose_f(filespace, hdf5_err) - call h5sclose_f(memspace, hdf5_err) - call h5dclose_f(dset_id, hdf5_err) - call h5pclose_f(plist_id, hdf5_err) - call h5fclose_f(hdf5_source, hdf5_err) - if (master) write(15,*) source_bank -#else - ! Get current offset for master - if (master) call MPI_FILE_GET_POSITION(fh, offset, mpi_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 - - ! Set 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 - call MPI_FILE_READ_AT(fh, offset, source_bank(1), work, MPI_BANK, & - MPI_STATUS_IGNORE, mpi_err) -#endif - end if - - ! Close binary state point file -#ifndef HDF5 - call MPI_FILE_CLOSE(fh, mpi_err) -#endif -#else - ! Open binary state point file for writing - open(UNIT=UNIT_STATE, FILE=path_state_point, STATUS='old', & - ACCESS='stream') - - ! Raad revision number for state point file and make sure it matches with - ! current version - read(UNIT_STATE) temp(1) - if (temp(1) /= REVISION_STATEPOINT) then - message = "State point binary version does not match current version " & - // "in OpenMC." - call fatal_error() - end if - - ! Read OpenMC version - read(UNIT_STATE) temp(1:3) - if (temp(1) /= VERSION_MAJOR .or. temp(2) /= VERSION_MINOR & - .or. temp(3) /= VERSION_RELEASE) then - message = "State point file was created with a different version " // & - "of OpenMC." - call warning() - end if - - ! Read date and time - read(UNIT_STATE) current_time - - ! Read path - read(UNIT_STATE) path_temp - - ! Read and overwrite random number seed - read(UNIT_STATE) seed - - ! Read and overwrite run information - read(UNIT_STATE) mode, n_particles, n_batches - - ! Read batch number to restart at - read(UNIT_STATE) restart_batch - - ! Read information specific to eigenvalue run - if (mode == MODE_EIGENVALUE) then - read(UNIT_STATE) n_inactive, gen_per_batch - read(UNIT_STATE) k_batch(1:restart_batch) - read(UNIT_STATE) entropy(1:restart_batch*gen_per_batch) - read(UNIT_STATE) k_col_abs - read(UNIT_STATE) k_col_tra - read(UNIT_STATE) k_abs_tra - allocate(real_array(2)) - read(UNIT_STATE) real_array - deallocate(real_array) - end if - - if (master) then - ! Read number of meshes - read(UNIT_STATE) temp(1) - if (temp(1) /= n_meshes) then - message = "Number of meshes does not match in state point." - call fatal_error() - end if - - MESH_LOOP: do i = 1, n_meshes - ! Read id, mesh type, and dimension - read(UNIT_STATE) temp(1:3) - - ! Allocate temporary arrays - allocate(int_array(temp(3))) - allocate(real_array(temp(3))) - - ! Read dimension, lower_left, upper_right, width - read(UNIT_STATE) int_array - read(UNIT_STATE) real_array - read(UNIT_STATE) real_array - read(UNIT_STATE) real_array - - ! Deallocate temporary arrays - deallocate(int_array) - deallocate(real_array) - end do MESH_LOOP - - ! Read number of tallies and make sure it matches - read(UNIT_STATE) temp(1) - if (temp(1) /= n_tallies) then - message = "Number of tallies does not match in state point." - call fatal_error() - end if - - TALLY_METADATA: do i = 1, n_tallies - ! Read id - read(UNIT_STATE) temp(1) - - ! Read number of realizations - read(UNIT_STATE) tallies(i) % n_realizations - - ! Read dimensions of tally filters and results and make sure they - ! match - read(UNIT_STATE) temp(1:2) - if (temp(1) /= size(tallies(i) % results, 1) .or. & - temp(2) /= size(tallies(i) % results, 2)) then - message = "Tally dimensions do not match in state point." - call fatal_error() - end if - - ! Read number of filters - read(UNIT_STATE) temp(1) - - FILTER_LOOP: do j = 1, temp(1) - ! Read filter type and number of bins - read(UNIT_STATE) temp(2:3) - - ! Read filter bins - select case (temp(2)) - case (FILTER_MESH) - allocate(int_array(1)) - read(UNIT_STATE) int_array - deallocate(int_array) - case (FILTER_ENERGYIN, FILTER_ENERGYOUT) - allocate(real_array(temp(3) + 1)) - read(UNIT_STATE) real_array - deallocate(real_array) - case default - allocate(int_array(temp(3))) - read(UNIT_STATE) int_array - deallocate(int_array) - end select - end do FILTER_LOOP - - ! Read number of nuclides - read(UNIT_STATE) temp(1) - - ! Read nuclide bins - allocate(int_array(temp(1))) - read(UNIT_STATE) int_array - deallocate(int_array) - - ! Read number of results - read(UNIT_STATE) temp(1) - - ! Read results bins and scatt_order - allocate(int_array(temp(1))) - read(UNIT_STATE) int_array - read(UNIT_STATE) int_array - deallocate(int_array) - - ! Read number of user bins - read(UNIT_STATE) temp(1) - end do TALLY_METADATA - - ! Read number of realizations for global tallies - read(UNIT_STATE) n_realizations - - ! Read number of global tallies and make sure it matches - read(UNIT_STATE) temp(1) - if (temp(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 - do i = 1, N_GLOBAL_TALLIES - read(UNIT_STATE) global_tallies(i) % sum - read(UNIT_STATE) global_tallies(i) % sum_sq - end do - - ! Read sum and sum squared - read(UNIT_STATE) temp(1) - if (temp(1) == 1) then - TALLY_RESULTS: do i = 1, n_tallies - do k = 1, size(tallies(i) % results, 2) - do j = 1, size(tallies(i) % results, 1) - read(UNIT_STATE) tallies(i) % results(j,k) % sum - read(UNIT_STATE) tallies(i) % results(j,k) % sum_sq + ! Close tally group + call h5gclose_f(tally_group, hdf5_err) +# elif MPI + n = size(tallies(i) % results, 1) * size(tallies(i) % results, 2) + call MPI_FILE_READ(fh, tallies(i) % results, n, MPI_TALLYRESULT, & + MPI_STATUS_IGNORE, mpi_err) +# else + do k = 1, size(tallies(i) % results, 2) + do j = 1, size(tallies(i) % results, 1) + read(UNIT_STATE) tallies(i) % results(j,k) % sum + read(UNIT_STATE) tallies(i) % results(j,k) % sum_sq + end do end do - end do +# endif end do TALLY_RESULTS end if end if - - ! Read source bank for eigenvalue run - if (mode == MODE_EIGENVALUE .and. run_mode /= MODE_TALLIES) then - read(UNIT_STATE) source_bank - end if - ! Close binary state point file - close(UNIT_STATE) -#endif + ! Read source bank + if (run_mode == MODE_EIGENVALUE) then +# ifdef HDF5 + call read_source() +# elif MPI + call read_source(fh) +# else + call read_source() +# endif + endif + + ! Close statepoint file + if (.not. source_separate) then +# ifdef HDF5 + call h5fclose_f(hdf5_state_point, hdf5_err) +# elif MPI + call MPI_FILE_CLOSE(fh, mpi_err) +# endif + end if end subroutine load_state_point @@ -1627,6 +1578,19 @@ contains call h5dwrite_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err) call h5dclose_f(dset_id, hdf5_err) call h5sclose_f(filespace, hdf5_err) +# elif MPI + if (master) then + offset = 0 + call MPI_FILE_WRITE_AT(fh, offset, n_particles, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpi_err) + end if + + ! Set proper offset for source data on this processor + offset = 8*(1 + rank*maxwork*8) + + ! Write all source sites + call MPI_FILE_WRITE_AT(fh, offset, source_bank(1), work, MPI_BANK, & + MPI_STATUS_IGNORE, mpi_err) # else write(UNIT_STATE) source_bank # endif @@ -1636,11 +1600,16 @@ contains end subroutine write_source !=============================================================================== -! READ_SOURCE_BINARY reads a source distribution from a source.binary file and -! initializes the source bank +! READ_SOURCE reads a source distribution !=============================================================================== - subroutine read_source_binary() +#ifdef HDF5 + subroutine read_source() +#elif MPI + subroutine read_source(fh) +#else + subroutine read_source() +#endif integer :: i ! loop over repeating sites integer(8) :: n_sites ! number of sites in binary file @@ -1650,106 +1619,120 @@ contains integer(MPI_OFFSET_KIND) :: offset ! offset in memory (0=beginning of file) integer :: n_read ! number of sites to read on a single process #endif - -#ifdef MPI - ! ========================================================================== - ! PARALLEL I/O USING MPI-2 ROUTINES - - ! Open binary source file for reading - call MPI_FILE_OPEN(MPI_COMM_WORLD, path_source, MPI_MODE_RDONLY, & - MPI_INFO_NULL, fh, mpi_err) - - ! Read number of source sites in file - offset = 0 - call MPI_FILE_READ_AT(fh, offset, n_sites, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) - - if (n_particles > n_sites) then - ! Determine number of sites to read and offset - if (rank <= mod(n_sites,int(n_procs,8)) - 1) then - n_read = int(n_sites/n_procs) + 1 - offset = 8*(1 + rank*n_read*8) - else - n_read = int(n_sites/n_procs) - offset = 8*(1 + (rank*n_read + mod(n_sites,int(n_procs,8)))*8) - end if - - ! Read source sites - call MPI_FILE_READ_AT(fh, offset, source_bank(1), n_read, MPI_BANK, & - MPI_STATUS_IGNORE, mpi_err) - - ! Let's say we have 30 sites and we need to fill in 200. This do loop - ! will fill in sites 31 - 180. - - n_repeat = int(work / n_read) - do i = 1, n_repeat - 1 - source_bank(i*n_read + 1:(i+1)*n_read) = & - source_bank((i-1)*n_read + 1:i*n_read) - end do - - ! This final statement would fill sites 181 - 200 in the above example. - - if (mod(work, int(n_repeat*n_read,8)) > 0) then - source_bank(n_repeat*n_read + 1:work) = & - source_bank(1:work - n_repeat * n_read) - end if - - else - ! Set proper offset for source data on this processor - offset = 8*(1 + rank*maxwork*8) - - ! Read all source sites - call MPI_FILE_READ_AT(fh, offset, source_bank(1), work, MPI_BANK, & - MPI_STATUS_IGNORE, mpi_err) - - ! Close binary source file - call MPI_FILE_CLOSE(fh, mpi_err) - end if - -#else - ! ========================================================================== - ! SERIAL I/O USING FORTRAN INTRINSIC ROUTINES - - ! Open binary source file for reading - open(UNIT=UNIT_SOURCE, FILE=path_source, STATUS='old', & - ACCESS='stream') - - ! Read number of source sites in file - read(UNIT=UNIT_SOURCE) n_sites - - if (n_particles > n_sites) then - ! The size of the source file is smaller than the number of particles we - ! need. Thus, read all sites and then duplicate sites as necessary. - - read(UNIT=UNIT_SOURCE) source_bank(1:n_sites) - - ! Let's say we have 300 sites and we need to fill in 1000. This do loop - ! will fill in sites 301 - 900. - - n_repeat = int(n_particles / n_sites) - do i = 1, n_repeat - 1 - source_bank(i*n_sites + 1:(i+1)*n_sites) = & - source_bank((i-1)*n_sites + 1:i*n_sites) - end do - - ! This final statement would fill sites 901 - 1000 in the above example. - - source_bank(n_repeat*n_sites + 1:n_particles) = & - source_bank(1:n_particles - n_repeat * n_sites) - - else - ! The size of the source file is bigger than or equal to the number of - ! particles we need for one generation. Thus, we can just read as many - ! sites as we need. - - read(UNIT=UNIT_SOURCE) source_bank(1:n_particles) - - end if - - ! Close binary source file - close(UNIT=UNIT_SOURCE) +#ifdef HDF5 + integer(HID_T) :: hdf5_source + integer(HSIZE_T) :: dims(1) + integer(HID_T) :: filespace + integer(HID_T) :: memspace + character(6) :: dsetname = 'source' + integer(HID_T) :: dset_id + integer(HID_T) :: plist_id + type(c_ptr) :: f_ptr #endif - end subroutine read_source_binary +#ifdef MPI +# ifdef HDF5 + ! Parallel HDF5 must be written out separately + source_separate = .true. +# endif +#endif + call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) + call MPI_ABORT(MPI_COMM_WORLD,-2,mpi_err) + ! Check if source separate + if (source_separate) then +# ifdef MPI +# ifdef HDF5 + call h5fclose_f(hdf5_state_point, hdf5_err) + path_source = "source." // trim(to_str(restart_batch)) // ".h5" + call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) + call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) + call h5fopen_f(trim(path_source), H5F_ACC_RDONLY_F, hdf5_source, hdf5_err, access_prp=plist_id) + call h5pclose_f(plist_id, hdf5_err) + call h5dopen_f(hdf5_source, dsetname, dset_id, hdf5_err) + call h5dget_space_f(dset_id, filespace, hdf5_err) + call h5sselect_hyperslab_f(filespace, H5S_SELECT_SET_F, (/bank_first-1/), (/work/), hdf5_err) + call h5screate_simple_f(1, (/work/), memspace, hdf5_err) + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdf5_err) + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + f_ptr = c_loc(source_bank(1)) + call h5dread_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err, file_space_id = filespace, mem_space_id = memspace, & + xfer_prp = plist_id) + call h5sclose_f(filespace, hdf5_err) + call h5sclose_f(memspace, hdf5_err) + call h5dclose_f(dset_id, hdf5_err) + call h5pclose_f(plist_id, hdf5_err) + call h5fclose_f(hdf5_source, hdf5_err) +# else + ! Close statepoint file + call MPI_FILE_CLOSE(fh, mpi_err) + + ! Open binary source file for reading + call MPI_FILE_OPEN(MPI_COMM_WORLD, path_source, MPI_MODE_RDONLY, & + MPI_INFO_NULL, fh, mpi_err) + + ! Read number of source sites in file + offset = 0 + call MPI_FILE_READ_AT(fh, offset, n_sites, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpi_err) + + ! Set proper offset for source data on this processor + offset = 8*(1 + rank*maxwork*8) + + ! Read all source sites + call MPI_FILE_READ_AT(fh, offset, source_bank(1), work, MPI_BANK, & + MPI_STATUS_IGNORE, mpi_err) + + ! Close binary source file + call MPI_FILE_CLOSE(fh, mpi_err) +# endif +# else + ! Open binary source file for reading + open(UNIT=UNIT_SOURCE, FILE=path_source, STATUS='old', & + ACCESS='stream') + + ! Read number of source sites in file + read(UNIT=UNIT_SOURCE) n_sites + + ! Read in the source bank + read(UNIT=UNIT_SOURCE) source_bank(1:n_particles) + + ! Close binary source file + close(UNIT=UNIT_SOURCE) +# endif + + ! Read from statepoint file + else +# ifdef HDF5 + ! Open dataset for source bank + call h5dopen_f(hdf5_state_point, "source_bank", dset_id, hdf5_err) + + ! Read source bank + f_ptr = c_loc(source_bank(1)) + call h5dread_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err) + + ! Close dataset for source bank + call h5dclose_f(dset_id, hdf5_err) + + ! Close HDF5 state point file + call h5fclose_f(hdf5_state_point, hdf5_err) +# elif MPI + ! Read number of source sites in file + offset = 0 + call MPI_FILE_READ_AT(fh, offset, n_sites, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpi_err) + + ! Set proper offset for source data on this processor + offset = 8*(1 + rank*maxwork*8) + + ! Read all source sites + call MPI_FILE_READ_AT(fh, offset, source_bank(1), work, MPI_BANK, & + MPI_STATUS_IGNORE, mpi_err) +# else + read(UNIT=UNIT_STATE) source_bank(1:n_particles) +# endif + + end if + + end subroutine read_source end module state_point From e9b54407fca96bc2ef7555df9dcdf58d3de57148 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 9 May 2013 20:23:39 -0400 Subject: [PATCH 08/65] fixed lines for closing files --- src/state_point.F90 | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index 030fefcffc..040e5c63d8 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -1098,7 +1098,7 @@ contains ! Read number of tallies and make sure it matches # ifdef HDF5 - call hdf5_write_integer(tallies_group, "n_tallies", temp(1)) + call hdf5_read_integer(tallies_group, "n_tallies", temp(1)) # elif MPI call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, & mpi_err) @@ -1109,6 +1109,8 @@ contains message = "Number of tallies does not match in state point." call fatal_error() end if +!call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) +!call MPI_ABORT(MPI_COMM_WORLD, -8, mpi_err) TALLY_METADATA: do i = 1, n_tallies @@ -1163,8 +1165,8 @@ contains # else read(UNIT_STATE) temp(1) # endif -call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) -call MPI_ABORT(MPI_COMM_WORLD, -8, mpi_err) +!call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) +!call MPI_ABORT(MPI_COMM_WORLD, -8, mpi_err) FILTER_LOOP: do j = 1, temp(1) #ifdef HDF5 @@ -1230,8 +1232,8 @@ call MPI_ABORT(MPI_COMM_WORLD, -8, mpi_err) ! Read number of nuclides # ifdef HDF5 - call hdf5_write_integer(temp_group, "n_nuclide_bins", & - tallies(i) % n_nuclide_bins) + call hdf5_read_integer(temp_group, "n_nuclide_bins", & + temp(1)) # elif MPI call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) @@ -1406,9 +1408,11 @@ call MPI_ABORT(MPI_COMM_WORLD, -8, mpi_err) ! Close statepoint file if (.not. source_separate) then # ifdef HDF5 - call h5fclose_f(hdf5_state_point, hdf5_err) + if (master) call h5fclose_f(hdf5_state_point, hdf5_err) # elif MPI call MPI_FILE_CLOSE(fh, mpi_err) +# else + close(UNIT_STATE) # endif end if @@ -1636,13 +1640,12 @@ call MPI_ABORT(MPI_COMM_WORLD, -8, mpi_err) source_separate = .true. # endif #endif - call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) - call MPI_ABORT(MPI_COMM_WORLD,-2,mpi_err) +!call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) +!call MPI_ABORT(MPI_COMM_WORLD,-2,mpi_err) ! Check if source separate if (source_separate) then # ifdef MPI # ifdef HDF5 - call h5fclose_f(hdf5_state_point, hdf5_err) path_source = "source." // trim(to_str(restart_batch)) // ".h5" call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) From 939fbf10cdaaf1e0f1e53da401ed46afc478a8b8 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 10 May 2013 10:58:18 -0400 Subject: [PATCH 09/65] added mpi interface and started abstracting statepoint output writing --- src/DEPENDENCIES | 6 + src/OBJECTS | 2 + src/hdf5_interface.F90 | 53 +- src/mpi_interface.F90 | 50 ++ src/output_interface.F90 | 159 ++++ src/state_point.F90 | 1719 +------------------------------------- 6 files changed, 291 insertions(+), 1698 deletions(-) create mode 100644 src/mpi_interface.F90 create mode 100644 src/output_interface.F90 diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index 8cafde3f41..31835c112f 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -251,6 +251,8 @@ mesh.o: mesh_header.o mesh.o: particle_header.o mesh.o: search.o +mpi_interface.o: constants.o + output.o: ace_header.o output.o: constants.o output.o: endf.o @@ -341,6 +343,7 @@ state_point.o: math.o state_point.o: output.o state_point.o: string.o state_point.o: tally_header.o +state_point.o: write_output_file.o string.o: constants.o string.o: error.o @@ -366,3 +369,6 @@ tally_initialize.o: global.o tally_initialize.o: tally_header.o timer_header.o: constants.o + +write_output_file.o: hdf5_interface.o +write_output_file.o: mpi_interface.o diff --git a/src/OBJECTS b/src/OBJECTS index c9612e6af0..763e6a50f8 100644 --- a/src/OBJECTS +++ b/src/OBJECTS @@ -38,7 +38,9 @@ material_header.o \ math.o \ mesh_header.o \ mesh.o \ +mpi_interface.o \ output.o \ +output_interface.o \ particle_header.o \ particle_restart.o \ particle_restart_write.o \ diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 936ec5661f..275129fbb0 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -20,11 +20,8 @@ module hdf5_interface implicit none - ! define array writing interface - interface hdf5_write_array - module procedure hdf5_write_double_1Darray - module procedure hdf5_write_integer_1Darray - end interface hdf5_write_array + integer(HID_T) :: hdf5_fh + integer(HID_T) :: temp_group #ifdef HDF5 @@ -1299,7 +1296,7 @@ contains ! HDF5_PARALLEL_FILE_CREATE !=============================================================================== - subroutine hdf5_parallel_file_create(filename, file_id, plist_id) + subroutine hdf5_parallel_file_create(filename, file_id) character(MAX_FILE_LEN) :: filename integer(HID_T) :: file_id @@ -1310,29 +1307,51 @@ contains call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) ! Create the file collectively - call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) call h5fcreate_f(trim(filename), H5F_ACC_TRUNC_F, file_id, hdf5_err, & access_prp = plist_id) + ! Close the property list + call h5pclose_f(plist_id, hdf5_err) + end subroutine hdf5_parallel_file_create !=============================================================================== ! HDF5_PARALLEL_FILE_CLOSE !=============================================================================== - subroutine hdf5_parallel_file_close(file_id, plist_id) + subroutine hdf5_parallel_file_close(file_id) integer(HID_T) :: file_id - integer(HID_T) :: plist_id ! Close property list and the file - call h5pclose_f(plist_id, hdf5_err) call h5fclose_f(file_id, hdf5_err) end subroutine hdf5_parallel_file_close #endif +!=============================================================================== +! HDF5_OPEN_GROUP +!=============================================================================== + + subroutine hdf5_open_group(group) + + character(*) :: group + + call h5gopen_f(hdf5_fh, trim(group), temp_group, hdf5_err) + + end subroutine hdf5_open_group + +!=============================================================================== +! HDF5_CLOSE_GROUP +!=============================================================================== + + subroutine hdf5_close_group() + + call h5gclose_f(temp_group, hdf5_err) + + end subroutine hdf5_close_group + !=============================================================================== ! HDF5_WRITE_INTEGER !=============================================================================== @@ -1435,6 +1454,20 @@ contains end subroutine hdf5_write_double_1Darray +!=============================================================================== +! HDF5_WRITE_STRING +!=============================================================================== + + subroutine hdf5_write_string(group, name, buffer) + + integer(HID_T), intent(in) :: group + character(*), intent(in) :: name + character(*), intent(in) :: buffer + + call h5ltmake_dataset_string_f(group, name, buffer, hdf5_err) + + end subroutine hdf5_write_string + !=============================================================================== ! HDF5_READ_INTEGER !=============================================================================== diff --git a/src/mpi_interface.F90 b/src/mpi_interface.F90 new file mode 100644 index 0000000000..9d18a83ce3 --- /dev/null +++ b/src/mpi_interface.F90 @@ -0,0 +1,50 @@ +module mpi_interface + + use constants + +#ifdef MPI + use mpi +#endif + + implicit none + + ! define array writing interface +! interface mpi_write_data +! module procedure mpi_write_integer +! module procedure mpi_write_double +! module procedure mpi_write_double_1Darray +! module procedure mpi_write_integer_1Darray +! end interface mpi_write_data + + integer :: mpi_err + +contains + +!=============================================================================== +! MPI_FILE_CREATE +!=============================================================================== + + subroutine mpi_file_create(filename, file_id) + + character(MAX_FILE_LEN) :: filename + integer :: file_id + + ! Create the file + call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, MPI_MODE_CREATE + & + MPI_MODE_WRONLY, MPI_INFO_NULL, file_id, mpi_err) + + end subroutine mpi_file_create + +!=============================================================================== +! MPI_CLOSE_FILE +!=============================================================================== + + subroutine mpi_close_file(file_id) + + integer :: file_id + + call MPI_FILE_CLOSE(file_id, mpi_err) + + end subroutine mpi_close_file + +end module mpi_interface diff --git a/src/output_interface.F90 b/src/output_interface.F90 new file mode 100644 index 0000000000..80fe771560 --- /dev/null +++ b/src/output_interface.F90 @@ -0,0 +1,159 @@ +module output_interface + + use constants + +#ifdef HDF5 + use hdf5_interface +#elif MPI + use mpi_interface +#endif + + implicit none + +#if MPI + integer :: fh_state_point ! mpi file for state point + integer :: fh_source ! mpi file for source +#endif + + interface write_data + module procedure write_integer + module procedure write_string + end interface write_data + + +contains + +!=============================================================================== +! FILE_CREATE +!=============================================================================== + + subroutine file_create(filename, fh_str) + + character(MAX_FILE_LEN) :: filename + character(MAX_WORD_LEN) :: fh_str + +#ifdef HDF5 +# ifdef MPI + if (trim(fh_str) == 'state_point') then + if (master) call hdf5_file_create(trim(trim(filename) // '.h5'), & + hdf5_fh) + else + call hdf5_parallel_file_create(trim(filename) // '.h5', & + hdf5_fh) + endif +# else + if (trim(fh_str) == 'state_point') then + call hdf5_file_create(trim(filename) // '.h5', & + hdf5_fh) + else + call hdf5_file_create(trim(filename) // '.h5', & + hdf5_fh) + endif +# endif +#elif MPI + if (trim(fh_str) == 'state_point') then + call mpi_file_create(trim(filename) // '.binary/' , fh_state_point) + else + call mpi_file_create(trim(filename) // '.binary', fh_source) + endif +#else + if (trim(fh_str) == 'state_point') then + open(UNIT=UNIT_STATE, FILE=trim(filename) // '.binary', STATUS='replace', & + ACCESS='stream') + else + open(UNIT=UNIT_SOURCE, FILE=trim(filename) // '.binary', STATUS='replace', & + ACCESS='stream') + endif +#endif + + end subroutine file_create + +!=============================================================================== +! FILE_CLOSE +!=============================================================================== + + subroutine file_close(fh_str) + + character(MAX_WORD_LEN) :: fh_str + +#ifdef HDF5 +# ifdef MPI + if (trim(fh_str) == 'state_point') then + if (master) call hdf5_file_close(hdf5_fh) + else + call hdf5_parallel_file_close(hdf5_fh) + endif +# else + call hdf5_file_close(hdf5_fh) + endif +# endif +#elif MPI + if (trim(fh_str) == 'state_point') then + call mpi_close_file(fh_state_point) + else + call mpi_close_file(fh_source) + endif +#else + if (trim(fh_str) == 'state_point') then + close(UNIT=UNIT_STATE) + else + close(UNIT=UNIT_SOURCE) + endif +#endif + + end subroutine file_close + + +!=============================================================================== +! WRITE_INTEGER +!=============================================================================== + + subroutine write_integer(buffer, name, group) + + integer, intent(in) :: buffer + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_write_integer(temp_group, name, buffer) + if (present(group)) call hdf5_close_group() +#elif MPI + +#else + +#endif + + end subroutine write_integer + +!=============================================================================== +! WRITE_STRING +!=============================================================================== + + subroutine write_string(buffer, name, group) + + character(*), intent(in) :: buffer + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_write_string(temp_group, name, buffer) + if (present(group)) call hdf5_close_group() +#elif MPI + +#else + +#endif + + end subroutine write_string + +end module output_interface diff --git a/src/state_point.F90 b/src/state_point.F90 index 040e5c63d8..207b6e7bf3 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -1,1741 +1,84 @@ module state_point -!=============================================================================== -! STATE_POINT -- This module handles writing and reading binary state point -! files. State points are contain complete tally results, source sites, and -! various other data. They can be used to restart a run or to reconstruct -! confidence intervals for tallies (this requires post-processing via Python -! scripts). -! -! Modifications to this module should be made with care. There are essentially -! three different ways to write or read state points: 1) normal Fortran file -! I/O, 2) MPI-IO, and 3) HDF5. The HDF5 functionality is contained in the -! hdf5_interface module. If you plan to change the state point, you will need to -! change all methods. You should also increment REVISION_STATEPOINT in the -! constants module. -! -! State points can be written at any batch during a simulation, or at specified -! intervals, using the tag. -!=============================================================================== - - use error, only: warning, fatal_error + use constants use global - use hdf5_interface - use math, only: t_percentile - use output, only: write_message, print_batch_keff, time_stamp - use string, only: to_str - use tally_header, only: TallyObject - -#ifdef MPI - use mpi -#endif - - implicit none + use output, only: write_message + use string, only: to_str + use output_interface, only: file_create, write_data, file_close, write_string contains !=============================================================================== -! WRITE_STATE_POINT creates a state point binary file that can be used for -! restarting a run or for getting intermediate tally results +! WRITE_STATE_POINT !=============================================================================== subroutine write_state_point() - integer :: i ! loop index -#ifdef MPI - integer :: fh ! file handle - integer :: n ! temporary array length - integer :: temp ! temporary variable - integer :: size_offset_kind ! size of MPI_OFFSET_KIND (bytes) - integer :: size_bank ! size of MPI_BANK type - integer(MPI_OFFSET_KIND) :: offset ! offset in memory (0=beginning of file) -#else - integer :: j, k ! loop indices -#endif character(MAX_FILE_LEN) :: filename - type(TallyObject), pointer :: t => null() - -# ifdef HDF5 - integer(HSIZE_T) :: dims(1) ! dimensions of 1D arrays - integer(HSIZE_T) :: dims2(2) ! dimensions of 2D arrays - integer(HID_T) :: dspace ! identifier for dataspace - integer(HID_T) :: dset ! identifier for dataset - integer(HID_T) :: tallies_group ! "tallies" group - integer(HID_T) :: temp_group ! group for i-th tally or mesh - type(c_ptr) :: f_ptr ! Pointer for h5dwrite -#endif + character(MAX_WORD_LEN) :: fh_state_point = "state_point" + character(MAX_WORD_LEN) :: fh_source = "source" ! Set filename for state point -#ifdef HDF5 filename = trim(path_output) // 'statepoint.' // & - trim(to_str(current_batch)) // '.h5' -#else - filename = trim(path_output) // 'statepoint.' // & - trim(to_str(current_batch)) // '.binary' -#endif + trim(to_str(current_batch)) ! Write message message = "Creating state point " // trim(filename) // "..." call write_message(1) ! Create statepoint file -# ifdef HDF5 - if (master) call hdf5_file_create(filename, hdf5_state_point) -# elif MPI - call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, MPI_MODE_CREATE + & - MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpi_err) -# else - open(UNIT=UNIT_STATE, FILE=filename, STATUS='replace', & - ACCESS='stream') -# endif + call file_create(filename, fh_state_point) - ! ========================================================================== - ! RUN INFORMATION AND TALLY METADATA + if (master) then - if (master) call write_state_point_header(fh) + ! Write revision number for state point file + call write_data(REVISION_STATEPOINT, "revision_statepoint") - ! ========================================================================== - ! TALLY RESULTS + ! Write OpenMC version + call write_data(VERSION_MAJOR, "version_major") + call write_data(VERSION_MINOR, "version_minor") + call write_data(VERSION_RELEASE, "version_release") - if (.not. reduce_tallies) then - ! If using the no-tally-reduction method, we need to collect tally - ! results before writing them to the state point file. + ! Write current date and time + call write_string(time_stamp(), "date_and_time") - call write_tally_results_nr(fh) - - elseif (master) then - ! Write number of realizations -# ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "n_realizations", & - n_realizations) -# elif MPI - call MPI_FILE_WRITE(fh, n_realizations, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) n_realizations -# endif - - ! Write global tallies -# ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "n_global_tallies", & - N_GLOBAL_TALLIES) - dims(1) = N_GLOBAL_TALLIES - call h5screate_simple_f(1, dims, dspace, hdf5_err) - call h5dcreate_f(hdf5_state_point, "global_tallies", & - hdf5_tallyresult_t, dspace, dset, hdf5_err) - f_ptr = c_loc(global_tallies(1)) - call h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) -# elif MPI - call MPI_FILE_WRITE(fh, N_GLOBAL_TALLIES, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, global_tallies, N_GLOBAL_TALLIES, & - MPI_TALLYRESULT, MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) N_GLOBAL_TALLIES - GLOBAL_TALLIES_LOOP: do i = 1, N_GLOBAL_TALLIES - write(UNIT_STATE) global_tallies(i) % sum - write(UNIT_STATE) global_tallies(i) % sum_sq - end do GLOBAL_TALLIES_LOOP -# endif - - ! Write tallies - if (tallies_on) then - -#ifdef HDF5 - ! Open group "tallies" - call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) -#endif - - ! Indicate that tallies are on -# ifdef HDF5 - call hdf5_write_integer(tallies_group, "tallies_present", 1) -# elif MPI - temp = 1 - call MPI_FILE_WRITE(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) 1 -# endif - - ! Write all tally results - TALLY_RESULTS: do i = 1, n_tallies - t => tallies(i) -#ifdef HDF5 - ! Open group for the i-th tally - call h5gopen_f(tallies_group, "tally" // to_str(i), & - temp_group, hdf5_err) -#endif - - ! Write sum and sum_sq for each bin -# ifdef HDF5 - dims2 = shape(t % results) - call h5screate_simple_f(2, dims2, dspace, hdf5_err) - call h5dcreate_f(temp_group, "results", hdf5_tallyresult_t, & - dspace, dset, hdf5_err) - f_ptr = c_loc(t % results(1, 1)) - call h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) -# elif MPI - n = size(t % results, 1) * size(t % results, 2) - call MPI_FILE_WRITE(fh, t % results, n, MPI_TALLYRESULT, & - MPI_STATUS_IGNORE, mpi_err) -# else - do k = 1, size(t % results, 2) - do j = 1, size(t % results, 1) - write(UNIT_STATE) t % results(j,k) % sum - write(UNIT_STATE) t % results(j,k) % sum_sq - end do - end do -# endif - -#ifdef HDF5 - ! Close group for the i-th tally - call h5gclose_f(temp_group, hdf5_err) -#endif - end do TALLY_RESULTS - -#ifdef HDF5 - ! Close the tallies group - call h5gclose_f(tallies_group, hdf5_err) -#endif - - else - ! Indicate that tallies are off -# ifdef HDF5 - call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) - call hdf5_write_integer(tallies_group, "tallies_present", 0) - call h5gclose_f(tallies_group, hdf5_err) -# elif MPI - temp = 0 - call MPI_FILE_WRITE(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) 0 -# endif - end if end if - ! Append more output data in statepoint file here, source last - - ! Write out source bank - if (run_mode == MODE_EIGENVALUE) then - if (source_write) then -# ifdef HDF5 - path_source = "source." // trim(to_str(current_batch)) // ".h5" -# else - path_source = "source." // trim(to_str(current_batch)) // ".binary" -# endif - call write_source() - end if - endif - - ! Close statepoint file if it hasn't already been closed - if (.not. source_separate) then -# ifdef HDF5 - if (master) call h5fclose_f(hdf5_state_point, hdf5_err) -# elif MPI - call MPI_FILE_CLOSE(fh, mpi_err) -# else - close(UNIT_STATE) -# endif - end if + ! Close statepoint file + call file_close(fh_state_point) end subroutine write_state_point -#ifdef MPI !=============================================================================== -! WRITE_STATE_POINT_HEADER uses MPI-IO routines to write basic run information -! and tally metadata -!=============================================================================== - - subroutine write_state_point_header(fh) - - integer, intent(inout) :: fh ! file handle - - integer :: i ! loop index - integer :: j ! loop index - integer :: n ! temporary array length - type(TallyObject), pointer :: t => null() - -#ifdef HDF5 - integer(HSIZE_T) :: dims(1) ! dimensions of 1D arrays - integer(HID_T) :: tallies_group ! "tallies" group - integer(HID_T) :: temp_group ! group for i-th tally or mesh - integer(HID_T) :: filter_group ! group for i-th filter - integer, allocatable :: temp_array(:) ! nuclide bin array -#endif - - ! Write revision number for state point file -# ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "revision_statepoint", & - REVISION_STATEPOINT) -# elif MPI - call MPI_FILE_WRITE(fh, REVISION_STATEPOINT, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) REVISION_STATEPOINT -# endif - - ! Write OpenMC version -# ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "version_major", & - VERSION_MAJOR) - call hdf5_write_integer(hdf5_state_point, "version_minor", & - VERSION_MINOR) - call hdf5_write_integer(hdf5_state_point, "version_release", & - VERSION_RELEASE) -# elif MPI - call MPI_FILE_WRITE(fh, VERSION_MAJOR, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, VERSION_MINOR, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, VERSION_RELEASE, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) VERSION_MAJOR, VERSION_MINOR, VERSION_RELEASE -# endif - - ! Write current date and time -# ifdef HDF5 - call h5ltmake_dataset_string_f(hdf5_state_point, "date_and_time", & - time_stamp(), hdf5_err) -# elif MPI - call MPI_FILE_WRITE(fh, time_stamp(), 19, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) time_stamp() -# endif - - ! Write path to input -# ifdef HDF5 - call h5ltmake_dataset_string_f(hdf5_state_point, "path", & - path_input, hdf5_err) -# elif MPI - call MPI_FILE_WRITE(fh, path_input, MAX_FILE_LEN, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) path_input -# endif - - ! Write out random number seed -# ifdef HDF5 - call hdf5_write_long(hdf5_state_point, "seed", seed) -# elif MPI - call MPI_FILE_WRITE(fh, seed, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) seed -# endif - - ! Write run information -# ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "run_mode", run_mode) - call hdf5_write_long(hdf5_state_point, "n_particles", n_particles) - call hdf5_write_integer(hdf5_state_point, "n_batches", n_batches) -# elif MPI - call MPI_FILE_WRITE(fh, run_mode, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, n_particles, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, n_batches, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) run_mode, n_particles, n_batches -# endif - - ! Write out current batch number -# ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "current_batch", & - current_batch) -# elif MPI - call MPI_FILE_WRITE(fh, current_batch, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) current_batch -# endif - - ! Write out information for eigenvalue run - if (run_mode == MODE_EIGENVALUE) then -# ifdef HDF5 - call hdf5_write_integer(hdf5_state_point, "n_inactive", & - n_inactive) - call hdf5_write_integer(hdf5_state_point, "gen_per_batch", & - gen_per_batch) - dims(1) = current_batch - call h5ltmake_dataset_double_f(hdf5_state_point, "k_batch", 1, & - dims, k_batch, hdf5_err) - dims(1) = current_batch*gen_per_batch - call h5ltmake_dataset_double_f(hdf5_state_point, "entropy", 1, & - dims, entropy, hdf5_err) - call hdf5_write_double(hdf5_state_point, "k_col_abs", k_col_abs) - call hdf5_write_double(hdf5_state_point, "k_col_tra", k_col_tra) - call hdf5_write_double(hdf5_state_point, "k_abs_tra", k_abs_tra) - dims(1) = 2 - call h5ltmake_dataset_double_f(hdf5_state_point, "k_combined", 1, & - dims, k_combined, hdf5_err) -# elif MPI - call MPI_FILE_WRITE(fh, n_inactive, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, gen_per_batch, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, k_batch, current_batch, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, entropy, current_batch*gen_per_batch, & - MPI_REAL8, MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, k_col_abs, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, k_col_tra, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, k_abs_tra, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, k_combined, 2, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) n_inactive, gen_per_batch - write(UNIT_STATE) k_batch(1:current_batch) - write(UNIT_STATE) entropy(1:current_batch*gen_per_batch) - write(UNIT_STATE) k_col_abs - write(UNIT_STATE) k_col_tra - write(UNIT_STATE) k_abs_tra - write(UNIT_STATE) k_combined -# endif - end if - -#ifdef HDF5 - ! Create group "tallies" - call h5gcreate_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) -#endif - - ! Write number of meshes -# ifdef HDF5 - call hdf5_write_integer(tallies_group, "n_meshes", n_meshes) -# elif MPI - call MPI_FILE_WRITE(fh, n_meshes, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) n_meshes -# endif - - ! Write information for meshes - MESH_LOOP: do i = 1, n_meshes -# ifdef HDF5 - ! Create temporary group for each mesh - call h5gcreate_f(tallies_group, "mesh" // to_str(i), & - temp_group, hdf5_err) - - call hdf5_write_integer(temp_group, "id", meshes(i) % id) - call hdf5_write_integer(temp_group, "type", meshes(i) % type) - call hdf5_write_integer(temp_group, "n_dimension", & - meshes(i) % n_dimension) - dims(1) = meshes(i) % n_dimension - call hdf5_write_array(temp_group, "dimension", & - meshes(i) % dimension, 1, dims) - call hdf5_write_array(temp_group, "lower_left", & - meshes(i) % lower_left, 1, dims) - call hdf5_write_array(temp_group, "upper_right", & - meshes(i) % upper_right, 1, dims) - call hdf5_write_array(temp_group, "width", & - meshes(i) % width, 1, dims) - - ! Close temporary group for mesh - call h5gclose_f(temp_group, hdf5_err) -# elif MPI - call MPI_FILE_WRITE(fh, meshes(i) % id, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, meshes(i) % type, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, meshes(i) % n_dimension, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - n = meshes(i) % n_dimension - call MPI_FILE_WRITE(fh, meshes(i) % dimension, n, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, meshes(i) % lower_left, n, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, meshes(i) % upper_right, n, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, meshes(i) % width, n, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) meshes(i) % id - write(UNIT_STATE) meshes(i) % type - write(UNIT_STATE) meshes(i) % n_dimension - write(UNIT_STATE) meshes(i) % dimension - write(UNIT_STATE) meshes(i) % lower_left - write(UNIT_STATE) meshes(i) % upper_right - write(UNIT_STATE) meshes(i) % width -# endif - end do MESH_LOOP - - ! Write number of tallies -# ifdef HDF5 - call hdf5_write_integer(tallies_group, "n_tallies", n_tallies) -# elif MPI - call MPI_FILE_WRITE(fh, n_tallies, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) n_tallies -# endif - - TALLY_METADATA: do i = 1, n_tallies - ! Get pointer to tally - t => tallies(i) - -#ifdef HDF5 - ! Create group for this tally - call h5gcreate_f(tallies_group, "tally" // to_str(i), & - temp_group, hdf5_err) -#endif - - ! Write id -# ifdef HDF5 - call hdf5_write_integer(temp_group, "id", t % id) -# elif MPI - call MPI_FILE_WRITE(fh, t % id, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) t % id -# endif - - ! Write number of realizations -# ifdef HDF5 - call hdf5_write_integer(temp_group, "n_realizations", & - t % n_realizations) -# elif HDf5 - call MPI_FILE_WRITE(fh, t % n_realizations, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) t % n_realizations -# endif - - ! Write size of each tally -# ifdef HDF5 - call hdf5_write_integer(temp_group, "total_score_bins", & - t % total_score_bins) - call hdf5_write_integer(temp_group, "total_filter_bins", & - t % total_filter_bins) -# elif MPI - call MPI_FILE_WRITE(fh, t % total_score_bins, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, t % total_filter_bins, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) t % total_score_bins - write(UNIT_STATE) t % total_filter_bins -# endif - - ! Write number of filters -# ifdef HDF5 - call hdf5_write_integer(temp_group, "n_filters", t % n_filters) -# elif MPI - call MPI_FILE_WRITE(fh, t % n_filters, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) t % n_filters -# endif - - FILTER_LOOP: do j = 1, t % n_filters -#ifdef HDF5 - ! Create filter group - call h5gcreate_f(temp_group, "filter" // to_str(j), filter_group, & - hdf5_err) -#endif - - ! Write type of filter -# ifdef HDF5 - call hdf5_write_integer(filter_group, "type", & - t % filters(j) % type) -# elif MPI - call MPI_FILE_WRITE(fh, t % filters(j) % type, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) t % filters(j) % type -# endif - - ! Write number of bins for this filter -# ifdef HDF5 - call hdf5_write_integer(filter_group, "n_bins", & - t % filters(j) % n_bins) -# elif MPI - call MPI_FILE_WRITE(fh, t % filters(j) % n_bins, & - 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) t % filters(j) % n_bins -# endif - - ! Write bins - if (t % filters(j) % type == FILTER_ENERGYIN .or. & - t % filters(j) % type == FILTER_ENERGYOUT) then -# ifdef HDF5 - dims(1) = size(t % filters(j) % real_bins) - call h5ltmake_dataset_double_f(filter_group, "bins", 1, & - dims, t % filters(j) % real_bins, hdf5_err) -# elif MPI - n = size(t % filters(j) % real_bins) - call MPI_FILE_WRITE(fh, t % filters(j) % real_bins, n, & - MPI_REAL8, MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) t % filters(j) % real_bins -# endif - else -# ifdef HDF5 - dims(1) = size(t % filters(j) % int_bins) - call h5ltmake_dataset_int_f(filter_group, "bins", 1, & - dims, t % filters(j) % int_bins, hdf5_err) -# elif MPI - n = size(t % filters(j) % int_bins) - call MPI_FILE_WRITE(fh, t % filters(j) % int_bins, n, & - MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) t % filters(j) % int_bins -# endif - end if - -#ifdef HDF5 - ! Write name of type - select case (t % filters(j) % type) - case(FILTER_UNIVERSE) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "universe", hdf5_err) - case(FILTER_MATERIAL) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "material", hdf5_err) - case(FILTER_CELL) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "cell", hdf5_err) - case(FILTER_CELLBORN) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "cellborn", hdf5_err) - case(FILTER_SURFACE) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "surface", hdf5_err) - case(FILTER_MESH) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "mesh", hdf5_err) - case(FILTER_ENERGYIN) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "energy", hdf5_err) - case(FILTER_ENERGYOUT) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "energyout", hdf5_err) - end select - - ! Close group for this filter - call h5gclose_f(filter_group, hdf5_err) -#endif - end do FILTER_LOOP - - ! Write number of nuclide bins -# ifdef HDF5 - call hdf5_write_integer(temp_group, "n_nuclide_bins", & - t % n_nuclide_bins) -# elif MPI - call MPI_FILE_WRITE(fh, t % n_nuclide_bins, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) t % n_nuclide_bins -# endif - -#ifdef HDF5 - ! Allocate array for HDf5 - allocate(temp_array(t % n_nuclide_bins)) -#endif - - ! Write nuclide bins - NUCLIDE_LOOP: do j = 1, t % n_nuclide_bins - if (t % nuclide_bins(j) > 0) then -# ifdef HDF5 - temp_array(j) = nuclides(t % nuclide_bins(j)) % zaid -# elif MPI - call MPI_FILE_WRITE(fh, nuclides(t % nuclide_bins(j)) % zaid, & - 1, MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) nuclides(t % nuclide_bins(j)) % zaid -# endif - else -# ifdef HDF5 - temp_array(j) = t % nuclide_bins(j) -# elif MPI - call MPI_FILE_WRITE(fh, t % nuclide_bins(j), 1, & - MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) t % nuclide_bins(j) -# endif - end if - end do NUCLIDE_LOOP - -#ifdef HDF5 - ! Write and deallocate nuclide bins - dims(1) = t % n_nuclide_bins - call h5ltmake_dataset_int_f(temp_group, "nuclide_bins", 1, & - dims, temp_array, hdf5_err) - deallocate(temp_array) -#endif - - ! Write number of score bins, score bins, and scatt order -# ifdef HDF5 - call hdf5_write_integer(temp_group, "n_score_bins", & - t % n_score_bins) - dims(1) = t % n_score_bins - call h5ltmake_dataset_int_f(temp_group, "score_bins", 1, & - dims, t % score_bins, hdf5_err) - call h5ltmake_dataset_int_f(temp_group, "scatt_order", 1, & - dims, t % scatt_order, hdf5_err) -# elif MPI - call MPI_FILE_WRITE(fh, t % n_score_bins, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, t % score_bins, t % n_score_bins, & - MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_WRITE(fh, t % scatt_order, t % n_score_bins, & - MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) t % n_score_bins - write(UNIT_STATE) t % score_bins - write(UNIT_STATE) t % scatt_order -# endif - - ! Write number of user score bins -# ifdef HDF5 - call hdf5_write_integer(temp_group, "n_user_score_bins", & - t % n_user_score_bins) -# elif MPI - call MPI_FILE_WRITE(fh, t % n_user_score_bins, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) t % n_user_score_bins -# endif - -#ifdef HDF5 - ! Close tally group - call h5gclose_f(temp_group, hdf5_err) -#endif - end do TALLY_METADATA - -# ifdef HDF5 - ! Close tallies group - call h5gclose_f(tallies_group, hdf5_err) -#endif - - end subroutine write_state_point_header -#endif - -#ifdef MPI -!=============================================================================== -! WRITE_TALLY_RESULTS_NR -!=============================================================================== - - subroutine write_tally_results_nr(fh) - - integer, intent(in) :: fh ! file handle - - integer :: i ! loop index - integer :: n ! number of filter bins - integer :: m ! number of score bins - integer :: temp ! temporary variable - integer :: n_bins ! total number of bins - real(8), allocatable :: tally_temp(:,:,:) ! contiguous array of results - real(8) :: global_temp(2,N_GLOBAL_TALLIES) - real(8) :: dummy ! temporary receive buffer for non-root reduces - type(TallyObject), pointer :: t => null() - - ! ========================================================================== - ! COLLECT AND WRITE GLOBAL TALLIES - - if (master) then - ! Write number of realizations - call MPI_FILE_WRITE(fh, n_realizations, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - - ! Write number of global tallies - call MPI_FILE_WRITE(fh, N_GLOBAL_TALLIES, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - end if - - ! Copy global tallies into temporary array for reducing - n_bins = 2 * N_GLOBAL_TALLIES - global_temp(1,:) = global_tallies(:) % sum - global_temp(2,:) = global_tallies(:) % sum_sq - - if (master) then - ! The MPI_IN_PLACE specifier allows the master to copy values into a - ! receive buffer without having a temporary variable - call MPI_REDUCE(MPI_IN_PLACE, global_temp, n_bins, MPI_REAL8, MPI_SUM, & - 0, MPI_COMM_WORLD, mpi_err) - - ! Write out global tallies sum and sum_sq - call MPI_FILE_WRITE(fh, global_temp, n_bins, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - - ! Transfer values to value on master - if (current_batch == n_batches) then - global_tallies(:) % sum = global_temp(1,:) - global_tallies(:) % sum_sq = global_temp(2,:) - end if - else - ! Receive buffer not significant at other processors - call MPI_REDUCE(global_temp, dummy, n_bins, MPI_REAL8, MPI_SUM, & - 0, MPI_COMM_WORLD, mpi_err) - end if - - if (tallies_on) then - ! Indicate that tallies are on - if (master) then - temp = 1 - call MPI_FILE_WRITE(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - end if - - ! Write all tally results - TALLY_RESULTS: do i = 1, n_tallies - t => tallies(i) - - ! Determine size of tally results array - m = size(t % results, 1) - n = size(t % results, 2) - n_bins = m*n*2 - - ! Allocate array for storing sums and sums of squares, but - ! contiguously in memory for each - allocate(tally_temp(2,m,n)) - tally_temp(1,:,:) = t % results(:,:) % sum - tally_temp(2,:,:) = t % results(:,:) % sum_sq - - if (master) then - ! The MPI_IN_PLACE specifier allows the master to copy values into - ! a receive buffer without having a temporary variable - call MPI_REDUCE(MPI_IN_PLACE, tally_temp, n_bins, MPI_REAL8, & - MPI_SUM, 0, MPI_COMM_WORLD, mpi_err) - - ! Write reduced tally results to file - call MPI_FILE_WRITE(fh, tally_temp, n_bins, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - - ! At the end of the simulation, store the results back in the - ! regular TallyResults array - if (current_batch == n_batches) then - t % results(:,:) % sum = tally_temp(1,:,:) - t % results(:,:) % sum_sq = tally_temp(2,:,:) - end if - else - ! Receive buffer not significant at other processors - call MPI_REDUCE(tally_temp, dummy, n_bins, MPI_REAL8, MPI_SUM, & - 0, MPI_COMM_WORLD, mpi_err) - end if - - ! Deallocate temporary copy of tally results - deallocate(tally_temp) - end do TALLY_RESULTS - else - if (master) then - ! Indicate that tallies are off - temp = 0 - call MPI_FILE_WRITE(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - end if - end if - - end subroutine write_tally_results_nr -#endif - -!=============================================================================== -! LOAD_STATE_POINT loads data from a state point file to either continue a run -! or to print intermediate tally results +! LOAD_STATE_POINT !=============================================================================== subroutine load_state_point() - integer :: i, j ! loop indices - integer :: mode ! specified run mode - integer :: temp(3) ! temporary variable - integer, allocatable :: int_array(:) - real(8), allocatable :: real_array(:) - character(19) :: current_time ! current date and time - character(MAX_FILE_LEN) :: path_temp - -#ifdef MPI - integer :: fh ! file handle - integer :: n ! temporary array size - integer :: size_offset_kind ! size of MPI_OFFSET_KIND (bytes) - integer :: size_bank ! size of MPI_BANK type - integer(MPI_OFFSET_KIND) :: offset ! offset in memory (0=beginning of file) -#else - integer :: k ! loop index -#endif - -#ifdef HDF5 - integer(HID_T) :: hdf5_state_point ! identifier for state point file - integer(HID_T) :: tally_group ! identifier for tally group - integer(HID_T) :: tallies_group - integer(HID_T) :: temp_group - integer(HID_T) :: filter_group - integer(HID_T) :: dset ! identifier for dataset - integer(HSIZE_T) :: dims(1) ! dimensions of 1D arrays - integer(HID_T) :: hdf5_source - integer(HID_T) :: filespace - integer(HID_T) :: memspace - character(6) :: dsetname = 'source' - integer(HID_T) :: dset_id - integer(HID_T) :: plist_id - type(c_ptr) :: f_ptr - integer(HSIZE_T) :: maxdims(1) -#endif - - ! Write message - message = "Loading state point " // trim(path_state_point) // "..." - call write_message(1) - - ! Open binary state point file for reading -# ifdef HDF5 - call h5fopen_f(path_state_point, H5F_ACC_RDONLY_F, & - hdf5_state_point, hdf5_err) -# elif MPI - call MPI_FILE_OPEN(MPI_COMM_WORLD, path_state_point, MPI_MODE_RDONLY, & - MPI_INFO_NULL, fh, mpi_err) -# else - open(UNIT=UNIT_STATE, FILE=path_state_point, STATUS='old', & - ACCESS='stream') -# endif - - ! ========================================================================== - ! RUN INFORMATION AND TALLY METADATA - - ! Read revision number for state point file and make sure it matches with - ! current version -# ifdef HDF5 - call hdf5_read_integer(hdf5_state_point, "revision_statepoint", temp(1)) -# elif MPI - call MPI_FILE_READ_ALL(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, & - mpi_err) -# else - read(UNIT_STATE) temp(1) -# endif - if (temp(1) /= REVISION_STATEPOINT) then - message = "State point binary version does not match current version " & - // "in OpenMC." - call fatal_error() - end if - - ! Read OpenMC version -# ifdef HDF5 - call hdf5_read_integer(hdf5_state_point, "version_major", temp(1)) - call hdf5_read_integer(hdf5_state_point, "version_minor", temp(2)) - call hdf5_read_integer(hdf5_state_point, "version_release", temp(3)) -# elif MPI - call MPI_FILE_READ_ALL(fh, temp, 3, MPI_INTEGER, MPI_STATUS_IGNORE, & - mpi_err) -# else - read(UNIT_STATE) temp(1:3) -# endif - if (temp(1) /= VERSION_MAJOR .or. temp(2) /= VERSION_MINOR & - .or. temp(3) /= VERSION_RELEASE) then - message = "State point file was created with a different version " // & - "of OpenMC." - call warning() - end if - - ! Read date and time -# ifdef HDF5 - call h5ltread_dataset_string_f(hdf5_state_point, "date_and_time", & - current_time, hdf5_err) ! TODO check this -# elif MPI - call MPI_FILE_READ_ALL(fh, current_time, 19, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) current_time -# endif - - ! Read path to input -# ifdef HDF5 - call h5ltread_dataset_string_f(hdf5_state_point, "path", & - path_temp, hdf5_err) -# elif MPI - call MPI_FILE_READ_ALL(fh, path_temp, MAX_FILE_LEN, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) path_temp -# endif - - ! Read and overwrite random number seed -# ifdef HDF5 - call hdf5_read_long(hdf5_state_point, "seed", seed) -# elif MPI - call MPI_FILE_READ_ALL(fh, seed, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) seed -# endif - - ! Read and overwrite run information except for n_batches -# ifdef HDF5 - call hdf5_read_integer(hdf5_state_point, "run_mode", mode) - call hdf5_read_long(hdf5_state_point, "n_particles", n_particles) - call hdf5_read_integer(hdf5_state_point, "n_batches", temp(1)) -# elif MPI - call MPI_FILE_READ_ALL(fh, mode, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, n_particles, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, temp(1), 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) mode, n_particles, temp(1) -# endif - - ! Allow user to specify more than n_batches - n_batches = max(n_batches, temp(1)) - - ! Read batch number to restart at -# ifdef HDF5 - call hdf5_read_integer(hdf5_state_point, "current_batch", restart_batch) -# elif MPI - call MPI_FILE_READ_ALL(fh, restart_batch, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) restart_batch -# endif - - ! Read information specific to eigenvalue run - if (mode == MODE_EIGENVALUE) then -# ifdef HDF5 - call hdf5_read_integer(hdf5_state_point, "n_inactive", temp(1)) - call hdf5_read_integer(hdf5_state_point, "gen_per_batch", & - gen_per_batch) - dims(1) = restart_batch - call h5ltread_dataset_double_f(hdf5_state_point, "k_batch", & - k_batch(1:restart_batch), dims, hdf5_err) - dims(1) = restart_batch*gen_per_batch - call h5ltread_dataset_double_f(hdf5_state_point, "entropy", & - entropy(1:restart_batch*gen_per_batch), dims, hdf5_err) - call hdf5_read_double(hdf5_state_point, "k_col_abs", k_col_abs) - call hdf5_read_double(hdf5_state_point, "k_col_tra", k_col_tra) - call hdf5_read_double(hdf5_state_point, "k_abs_tra", k_abs_tra) - ! not reading in k-combined because below code doesnt -# elif MPI - call MPI_FILE_READ_ALL(fh, temp(1), 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, gen_per_batch, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, k_batch, restart_batch, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, entropy, restart_batch*gen_per_batch, & - MPI_REAL8, MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, k_col_abs, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, k_col_tra, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ_ALL(fh, k_abs_tra, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - allocate(real_array(2)) - call MPI_FILE_READ_ALL(fh, real_array, 2, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) - deallocate(real_array) -# else - read(UNIT_STATE) temp(1), gen_per_batch - read(UNIT_STATE) k_batch(1:restart_batch) - read(UNIT_STATE) entropy(1:restart_batch*gen_per_batch) - read(UNIT_STATE) k_col_abs - read(UNIT_STATE) k_col_tra - read(UNIT_STATE) k_abs_tra - allocate(real_array(2)) - read(UNIT_STATE) real_array - deallocate(real_array) -# endif - - ! Allow user to modify n_inactive - n_inactive = max(n_inactive, temp(1)) - - end if - - if (master) then - ! Read number of meshes -# ifdef HDF5 - call h5gopen_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) ! TODO Close group - call hdf5_read_integer(tallies_group, "n_meshes", temp(1)) -# elif MPI - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, & - mpi_err) -# else - read(UNIT_STATE) temp(1) -# endif - if (temp(1) /= n_meshes) then - message = "Number of meshes does not match in state point." - call fatal_error() - end if - - MESH_LOOP: do i = 1, n_meshes - ! Read id, mesh type, and dimension -# ifdef HDF5 - ! Nothing performed for HDF5, skip reading of mesh -# elif MPI - call MPI_FILE_READ(fh, temp, 3, MPI_INTEGER, MPI_STATUS_IGNORE, & - mpi_err) - - ! Skip mesh data - call MPI_FILE_GET_POSITION(fh, offset, mpi_err) - offset = offset + temp(3)*(4 + 3*8) - call MPI_FILE_SEEK(fh, offset, MPI_SEEK_SET, mpi_err) -# else - ! Read id, mesh type, and dimension - read(UNIT_STATE) temp(1:3) - - ! Allocate temporary arrays - allocate(int_array(temp(3))) - allocate(real_array(temp(3))) - - ! Read dimension, lower_left, upper_right, width - read(UNIT_STATE) int_array - read(UNIT_STATE) real_array - read(UNIT_STATE) real_array - read(UNIT_STATE) real_array - - ! Deallocate temporary arrays - deallocate(int_array) - deallocate(real_array) -# endif - end do MESH_LOOP - - ! Read number of tallies and make sure it matches -# ifdef HDF5 - call hdf5_read_integer(tallies_group, "n_tallies", temp(1)) -# elif MPI - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, & - mpi_err) -# else - read(UNIT_STATE) temp(1) -# endif - if (temp(1) /= n_tallies) then - message = "Number of tallies does not match in state point." - call fatal_error() - end if -!call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) -!call MPI_ABORT(MPI_COMM_WORLD, -8, mpi_err) - - TALLY_METADATA: do i = 1, n_tallies - - ! Read tally id -# ifdef HDF5 - call h5gopen_f(tallies_group, "tally" // to_str(i), & - temp_group, hdf5_err) - call hdf5_read_integer(temp_group, "id", tallies(i) % id) -# elif MPI - call MPI_FILE_READ(fh, tallies(i) % id, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) tallies(i) % id -# endif - - ! Read number of realizations for tallies -# ifdef HDF5 - call hdf5_read_integer(temp_group, "n_realizations", & - tallies(i) % n_realizations) -# elif MPI - call MPI_FILE_READ(fh, tallies(i) % n_realizations, 1, & - MPI_INTEGER, MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) tallies(i) % n_realizations -# endif - - ! Read dimensions of tally filters and results and make sure they - ! match -# ifdef HDF5 - call hdf5_read_integer(temp_group, "total_score_bins", & - temp(1)) - call hdf5_read_integer(temp_group, "total_filter_bins", & - temp(2)) -# elif MPI - call MPI_FILE_READ(fh, temp, 2, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) temp(1:2) -# endif - if (temp(1) /= size(tallies(i) % results, 1) .or. & - temp(2) /= size(tallies(i) % results, 2)) then - message = "Tally dimensions do not match in state point." - call fatal_error() - end if - - ! Read number of filters -# ifdef HDF5 - call hdf5_read_integer(temp_group, "n_filters", temp(1)) -# elif MPI - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) temp(1) -# endif -!call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) -!call MPI_ABORT(MPI_COMM_WORLD, -8, mpi_err) - - FILTER_LOOP: do j = 1, temp(1) -#ifdef HDF5 - ! Open up the filter group - call h5gopen_f(temp_group, "filter" // to_str(j), filter_group, & - hdf5_err) -#endif - - ! Read filter type and number of bins -# ifdef HDF5 - call hdf5_read_integer(filter_group, "type", temp(2)) - call hdf5_read_integer(filter_group, "n_bins", temp(3)) -# elif MPI - call MPI_FILE_READ(fh, temp(2), 2, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) temp(2:3) -# endif - - ! Read filter bins - select case (temp(2)) - case (FILTER_MESH) - allocate(int_array(1)) -# ifdef HDF5 - ! Skip HDF5 reading of this -# elif MPI - call MPI_FILE_READ(fh, int_array, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) int_array -# endif - deallocate(int_array) - case (FILTER_ENERGYIN, FILTER_ENERGYOUT) - allocate(real_array(temp(3) + 1)) -# ifdef HDF5 - ! Skip HDF5 reading of this -# elif MPI - call MPI_FILE_READ(fh, real_array, temp(3) + 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) real_array -# endif - deallocate(real_array) - case default - allocate(int_array(temp(3))) -# ifdef HDF5 - ! Skip HDF5 reading of this -# elif MPI - call MPI_FILE_READ(fh, int_array, temp(3), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) int_array -# endif - deallocate(int_array) - end select - -#ifdef HDF5 - ! Close the filter group - call h5gclose_f(filter_group, hdf5_err) -#endif - - end do FILTER_LOOP - - ! Read number of nuclides -# ifdef HDF5 - call hdf5_read_integer(temp_group, "n_nuclide_bins", & - temp(1)) -# elif MPI - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) temp(1) -# endif - - ! Read nuclide bins - allocate(int_array(temp(1))) -# ifdef HDF5 - ! Skip HDF5 for reading this -# elif MPI - call MPI_FILE_READ(fh, int_array, temp(1), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) int_array -# endif - deallocate(int_array) - - ! Read number of score bins, score bins, and scatt_order -# ifdef HDF5 - ! Skip HDF5 for reading this -# elif MPI - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) temp(1) -# endif - allocate(int_array(temp(1))) -# ifdef HDF5 - ! Skip HDF5 for reading this -# elif MPI - call MPI_FILE_READ(fh, int_array, temp(1), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_READ(fh, int_array, temp(1), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) int_array - read(UNIT_STATE) int_array -# endif - deallocate(int_array) - - ! Read number of user score bins -# ifdef HDF5 - call hdf5_read_integer(temp_group, "n_user_score_bins", temp(1)) -# elif MPI - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) temp(1) -# endif - -#ifdef HDF5 - ! Close HDF5 temp group - call h5gclose_f(temp_group, hdf5_err) -#endif - end do TALLY_METADATA - - ! Read number of realizations for global tallies -# ifdef HDF5 - call hdf5_read_integer(hdf5_state_point, "n_realizations", & - n_realizations) -# elif MPI - call MPI_FILE_READ(fh, n_realizations, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT_STATE) n_realizations -# endif - - ! Read number of global tallies and make sure it matches -# ifdef HDF5 - call hdf5_read_integer(hdf5_state_point, "n_global_tallies", & - temp(1)) -# elif MPI - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, & - mpi_err) -# else - read(UNIT_STATE) temp(1) -# endif - if (temp(1) /= N_GLOBAL_TALLIES) then - message = "Number of global tallies does not match in state point." - call fatal_error() - end if -!call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) -!call MPI_ABORT(MPI_COMM_WORLD, -5, mpi_err) - - ! Read global tally data -# ifdef HDF5 - ! Open global tallies dataset - call h5dopen_f(hdf5_state_point, "global_tallies", dset, hdf5_err) - - ! Read global tallies - f_ptr = c_loc(global_tallies(1)) - call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) - - ! Close global tallies dataset - call h5dclose_f(dset, hdf5_err) -# elif MPI - call MPI_FILE_READ(fh, global_tallies, N_GLOBAL_TALLIES, & - MPI_TALLYRESULT, MPI_STATUS_IGNORE, mpi_err) -# else - do i = 1, N_GLOBAL_TALLIES - read(UNIT_STATE) global_tallies(i) % sum - read(UNIT_STATE) global_tallies(i) % sum_sq - end do -# endif - - ! Check if tally results are present -# ifdef HDF5 - call hdf5_read_integer(tallies_group, "tallies_present", temp(1)) -# elif MPI - call MPI_FILE_READ(fh, temp, 1, MPI_INTEGER, MPI_STATUS_IGNORE, & - mpi_err) -# else - read(UNIT_STATE) temp(1) -# endif - - ! ======================================================================= - ! TALLY RESULTS - - ! Read sum and sum squared - if (temp(1) == 1) then - TALLY_RESULTS: do i = 1, n_tallies -# ifdef HDF5 - ! Open tally group - call h5gopen_f(tallies_group, "tally" // to_str(i), tally_group, & - hdf5_err) - - ! Read number of realizations - call hdf5_read_integer(tally_group, "n_realizations", & - tallies(i) % n_realizations) - - ! Open dataset for tally results - call h5dopen_f(tally_group, "results", dset, hdf5_err) - - ! Read sum and sum_sq for each tally bin - f_ptr = c_loc(tallies(i) % results(1,1)) - call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) - - ! Close dataset for tally results - call h5dclose_f(dset, hdf5_err) - - ! Close tally group - call h5gclose_f(tally_group, hdf5_err) -# elif MPI - n = size(tallies(i) % results, 1) * size(tallies(i) % results, 2) - call MPI_FILE_READ(fh, tallies(i) % results, n, MPI_TALLYRESULT, & - MPI_STATUS_IGNORE, mpi_err) -# else - do k = 1, size(tallies(i) % results, 2) - do j = 1, size(tallies(i) % results, 1) - read(UNIT_STATE) tallies(i) % results(j,k) % sum - read(UNIT_STATE) tallies(i) % results(j,k) % sum_sq - end do - end do -# endif - end do TALLY_RESULTS - end if - end if - - ! Read source bank - if (run_mode == MODE_EIGENVALUE) then -# ifdef HDF5 - call read_source() -# elif MPI - call read_source(fh) -# else - call read_source() -# endif - endif - - ! Close statepoint file - if (.not. source_separate) then -# ifdef HDF5 - if (master) call h5fclose_f(hdf5_state_point, hdf5_err) -# elif MPI - call MPI_FILE_CLOSE(fh, mpi_err) -# else - close(UNIT_STATE) -# endif - end if - end subroutine load_state_point !=============================================================================== -! REPLAY_BATCH_HISTORY displays batch keff and entropy for each batch stored in -! a state point file +! WRITE_SOURCE !=============================================================================== - subroutine replay_batch_history - - integer :: n = 0 ! number of realizations - real(8), save :: temp(2) = ZERO ! temporary values for keff - real(8) :: alpha ! significance level for CI - real(8) :: t_value ! t-value for confidence intervals - - ! Write message at beginning - if (current_batch == 1) then - message = "Replaying history from state point..." - call write_message(1) - end if - - ! Add to number of realizations - if (current_batch > n_inactive) then - n = n + 1 - - temp(1) = temp(1) + k_batch(current_batch) - temp(2) = temp(2) + k_batch(current_batch)*k_batch(current_batch) - - ! calculate mean keff - keff = temp(1) / n - - if (n > 1) then - if (confidence_intervals) then - ! Calculate t-value for confidence intervals - alpha = ONE - CONFIDENCE_LEVEL - t_value = t_percentile(ONE - alpha/TWO, n - 1) - else - t_value = ONE - end if - - keff_std = t_value * sqrt((temp(2)/n - keff*keff)/(n - 1)) - end if - else - keff = k_batch(current_batch) - end if - - ! print out batch keff - if (master) call print_batch_keff() - - ! Write message at end - if (current_batch == restart_batch) then - message = "Resuming simulation..." - call write_message(1) - end if - - end subroutine replay_batch_history - -!=============================================================================== -! WRITE_SOURCE writes out the final source distribution to a binary or HDF5 -! file that can be used as a starting source in a new simulation -!=============================================================================== - -#ifdef HDF5 subroutine write_source() -#elif MPI - subroutine write_source(fh) -#else - subroutine write_source() -#endif - -#ifdef MPI - integer :: fh ! file handle - integer(MPI_OFFSET_KIND) :: offset ! offset in memory -#ifdef HDF5 - integer(HID_T) :: hdf5_source - integer(HSIZE_T) :: dims(1) - integer(HID_T) :: filespace - integer(HID_T) :: memspace - character(6) :: dsetname = 'source' - integer(HID_T) :: dset_id - integer(HID_T) :: plist_id - type(c_ptr) :: f_ptr -#endif -#endif - -#ifdef MPI -# ifdef HDF5 - ! Parallel HDF5 must be written out separately - source_separate = .true. -# endif -#endif - - ! Check if source separate - if (source_separate) then -# ifdef MPI -# ifdef HDF5 - if (master) call h5fclose_f(hdf5_state_point, hdf5_err) - call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) - call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, & - hdf5_err) - call h5fcreate_f(trim(path_source), H5F_ACC_TRUNC_F, & - hdf5_source, hdf5_err, access_prp=plist_id) - call h5pclose_f(plist_id, hdf5_err) - dims(1) = n_particles - call h5screate_simple_f(1, dims, filespace, hdf5_err) - call h5dcreate_f(hdf5_source, dsetname, hdf5_bank_t, filespace, & - dset_id, hdf5_err) - call h5sclose_f(filespace, hdf5_err) - call h5screate_simple_f(1, (/work/), memspace, hdf5_err) - call h5dget_space_f(dset_id, filespace, hdf5_err) - call h5sselect_hyperslab_f(filespace, H5S_SELECT_SET_F, & - (/bank_first-1/), (/work/), hdf5_err) - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdf5_err) - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - f_ptr = c_loc(source_bank(1)) - call h5dwrite_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err, & - file_space_id = filespace, mem_space_id = memspace, & - xfer_prp = plist_id) - call h5sclose_f(filespace, hdf5_err) - call h5sclose_f(memspace, hdf5_err) - call h5dclose_f(dset_id, hdf5_err) - call h5pclose_f(plist_id, hdf5_err) - call h5fclose_f(hdf5_source, hdf5_err) -# else - call MPI_FILE_CLOSE(fh, mpi_err) - call MPI_FILE_OPEN(MPI_COMM_WORLD, path_source, MPI_MODE_CREATE + & - MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpi_err) - if (master) then - offset = 0 - call MPI_FILE_WRITE_AT(fh, offset, n_particles, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) - end if - - ! Set proper offset for source data on this processor - offset = 8*(1 + rank*maxwork*8) - - ! Write all source sites - call MPI_FILE_WRITE_AT(fh, offset, source_bank(1), work, MPI_BANK, & - MPI_STATUS_IGNORE, mpi_err) - call MPI_FILE_CLOSE(fh, mpi_err) -# endif -# else - ! Open binary source file for writing - open(UNIT=UNIT_SOURCE, FILE=path_source, STATUS='replace', & - ACCESS='stream') - - ! Write the number of particles - write(UNIT=UNIT_SOURCE) n_particles - - ! Write information from the source bank - write(UNIT=UNIT_SOURCE) source_bank(1:work) - - ! Close binary source file - close(UNIT=UNIT_SOURCE) -# endif - - ! append source to statepoint file - else -# ifdef HDF5 - dims(1) = work - call h5screate_simple_f(1, dims, filespace, hdf5_err) - call h5dcreate_f(hdf5_state_point, "source_bank", hdf5_bank_t, & - filespace, dset_id, hdf5_err) - f_ptr = c_loc(source_bank(1)) - call h5dwrite_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err) - call h5dclose_f(dset_id, hdf5_err) - call h5sclose_f(filespace, hdf5_err) -# elif MPI - if (master) then - offset = 0 - call MPI_FILE_WRITE_AT(fh, offset, n_particles, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) - end if - - ! Set proper offset for source data on this processor - offset = 8*(1 + rank*maxwork*8) - - ! Write all source sites - call MPI_FILE_WRITE_AT(fh, offset, source_bank(1), work, MPI_BANK, & - MPI_STATUS_IGNORE, mpi_err) -# else - write(UNIT_STATE) source_bank -# endif - - end if end subroutine write_source !=============================================================================== -! READ_SOURCE reads a source distribution +! READ_SOURCE !=============================================================================== -#ifdef HDF5 subroutine read_source() -#elif MPI - subroutine read_source(fh) -#else - subroutine read_source() -#endif - - integer :: i ! loop over repeating sites - integer(8) :: n_sites ! number of sites in binary file - integer :: n_repeat ! number of times to repeat a site -#ifdef MPI - integer :: fh ! file handle - integer(MPI_OFFSET_KIND) :: offset ! offset in memory (0=beginning of file) - integer :: n_read ! number of sites to read on a single process -#endif -#ifdef HDF5 - integer(HID_T) :: hdf5_source - integer(HSIZE_T) :: dims(1) - integer(HID_T) :: filespace - integer(HID_T) :: memspace - character(6) :: dsetname = 'source' - integer(HID_T) :: dset_id - integer(HID_T) :: plist_id - type(c_ptr) :: f_ptr -#endif - -#ifdef MPI -# ifdef HDF5 - ! Parallel HDF5 must be written out separately - source_separate = .true. -# endif -#endif -!call MPI_BARRIER(MPI_COMM_WORLD, mpi_err) -!call MPI_ABORT(MPI_COMM_WORLD,-2,mpi_err) - ! Check if source separate - if (source_separate) then -# ifdef MPI -# ifdef HDF5 - path_source = "source." // trim(to_str(restart_batch)) // ".h5" - call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) - call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) - call h5fopen_f(trim(path_source), H5F_ACC_RDONLY_F, hdf5_source, hdf5_err, access_prp=plist_id) - call h5pclose_f(plist_id, hdf5_err) - call h5dopen_f(hdf5_source, dsetname, dset_id, hdf5_err) - call h5dget_space_f(dset_id, filespace, hdf5_err) - call h5sselect_hyperslab_f(filespace, H5S_SELECT_SET_F, (/bank_first-1/), (/work/), hdf5_err) - call h5screate_simple_f(1, (/work/), memspace, hdf5_err) - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdf5_err) - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - f_ptr = c_loc(source_bank(1)) - call h5dread_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err, file_space_id = filespace, mem_space_id = memspace, & - xfer_prp = plist_id) - call h5sclose_f(filespace, hdf5_err) - call h5sclose_f(memspace, hdf5_err) - call h5dclose_f(dset_id, hdf5_err) - call h5pclose_f(plist_id, hdf5_err) - call h5fclose_f(hdf5_source, hdf5_err) -# else - ! Close statepoint file - call MPI_FILE_CLOSE(fh, mpi_err) - - ! Open binary source file for reading - call MPI_FILE_OPEN(MPI_COMM_WORLD, path_source, MPI_MODE_RDONLY, & - MPI_INFO_NULL, fh, mpi_err) - - ! Read number of source sites in file - offset = 0 - call MPI_FILE_READ_AT(fh, offset, n_sites, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) - - ! Set proper offset for source data on this processor - offset = 8*(1 + rank*maxwork*8) - - ! Read all source sites - call MPI_FILE_READ_AT(fh, offset, source_bank(1), work, MPI_BANK, & - MPI_STATUS_IGNORE, mpi_err) - - ! Close binary source file - call MPI_FILE_CLOSE(fh, mpi_err) -# endif -# else - ! Open binary source file for reading - open(UNIT=UNIT_SOURCE, FILE=path_source, STATUS='old', & - ACCESS='stream') - - ! Read number of source sites in file - read(UNIT=UNIT_SOURCE) n_sites - - ! Read in the source bank - read(UNIT=UNIT_SOURCE) source_bank(1:n_particles) - - ! Close binary source file - close(UNIT=UNIT_SOURCE) -# endif - - ! Read from statepoint file - else -# ifdef HDF5 - ! Open dataset for source bank - call h5dopen_f(hdf5_state_point, "source_bank", dset_id, hdf5_err) - - ! Read source bank - f_ptr = c_loc(source_bank(1)) - call h5dread_f(dset_id, hdf5_bank_t, f_ptr, hdf5_err) - - ! Close dataset for source bank - call h5dclose_f(dset_id, hdf5_err) - - ! Close HDF5 state point file - call h5fclose_f(hdf5_state_point, hdf5_err) -# elif MPI - ! Read number of source sites in file - offset = 0 - call MPI_FILE_READ_AT(fh, offset, n_sites, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) - - ! Set proper offset for source data on this processor - offset = 8*(1 + rank*maxwork*8) - - ! Read all source sites - call MPI_FILE_READ_AT(fh, offset, source_bank(1), work, MPI_BANK, & - MPI_STATUS_IGNORE, mpi_err) -# else - read(UNIT=UNIT_STATE) source_bank(1:n_particles) -# endif - - end if end subroutine read_source +!=============================================================================== +! REPLAY_BATCH_HISTORY +!=============================================================================== + + subroutine replay_batch_history() + + end subroutine replay_batch_history + end module state_point From c8b4260e2235fcf3d19e4c46678aa1fd1c6a8a6c Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 10 May 2013 09:47:18 -0700 Subject: [PATCH 10/65] added more interface procedures for different data types, hdf5 interface can now open/create groups on fly --- src/DEPENDENCIES | 8 +-- src/hdf5_interface.F90 | 30 +++++++++-- src/output_interface.F90 | 110 +++++++++++++++++++++++++++++++++++++++ src/state_point.F90 | 35 +++++++++++-- 4 files changed, 171 insertions(+), 12 deletions(-) diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index 31835c112f..e9f72f72b3 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -266,6 +266,9 @@ output.o: plot_header.o output.o: string.o output.o: tally_header.o +output_interface.o: hdf5_interface.o +output_interface.o: mpi_interface.o + particle_header.o: constants.o particle_restart.o: bank_header.o @@ -343,7 +346,7 @@ state_point.o: math.o state_point.o: output.o state_point.o: string.o state_point.o: tally_header.o -state_point.o: write_output_file.o +state_point.o: output_interface.o string.o: constants.o string.o: error.o @@ -369,6 +372,3 @@ tally_initialize.o: global.o tally_initialize.o: tally_header.o timer_header.o: constants.o - -write_output_file.o: hdf5_interface.o -write_output_file.o: mpi_interface.o diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 275129fbb0..c78988c420 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -1338,7 +1338,19 @@ contains character(*) :: group - call h5gopen_f(hdf5_fh, trim(group), temp_group, hdf5_err) + logical :: status + + ! Check if group exists + call h5ltpath_valid_f(hdf5_fh, trim(group), .true., status, hdf5_err) + + ! Either create or open group + if (status) then + print *,'OPENING GROUP' + call h5gopen_f(hdf5_fh, trim(group), temp_group, hdf5_err) + else + print *,'CREATING GROUP' + call h5gcreate_f(hdf5_fh, trim(group), temp_group, hdf5_err) + end if end subroutine hdf5_open_group @@ -1374,14 +1386,18 @@ contains ! HDF5_WRITE_INTEGER_1DARRAY !=============================================================================== - subroutine hdf5_write_integer_1Darray(group, name, buffer, rank, dims) + subroutine hdf5_write_integer_1Darray(group, name, buffer, len) + integer, intent(in) :: len integer(HID_T), intent(in) :: group character(*), intent(in) :: name integer, intent(in) :: buffer(:) integer :: rank - integer(HSIZE_T) :: dims(rank) + integer(HSIZE_T) :: dims(1) + + rank = 1 + dims(1) = len call h5ltmake_dataset_int_f(group, name, rank, dims, & buffer, hdf5_err) @@ -1440,14 +1456,18 @@ contains ! HDF5_WRITE_DOUBLE_1DARRAY !=============================================================================== - subroutine hdf5_write_double_1Darray(group, name, buffer, rank, dims) + subroutine hdf5_write_double_1Darray(group, name, buffer, len) + integer, intent(in) :: len integer(HID_T), intent(in) :: group character(*), intent(in) :: name real(8), intent(in) :: buffer(:) integer :: rank - integer(HSIZE_T) :: dims(rank) + integer(HSIZE_T) :: dims(1) + + rank = 1 + dims(1) = len call h5ltmake_dataset_double_f(group, name, rank, dims, & buffer, hdf5_err) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 80fe771560..3993d28cc2 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -16,7 +16,11 @@ module output_interface #endif interface write_data + module procedure write_double + module procedure write_double_1Darray module procedure write_integer + module procedure write_integer_1Darray + module procedure write_long module procedure write_string end interface write_data @@ -103,6 +107,58 @@ contains end subroutine file_close +!=============================================================================== +! WRITE_INTEGER +!=============================================================================== + + subroutine write_double(buffer, name, group) + + real(8), intent(in) :: buffer + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_write_double(temp_group, name, buffer) + if (present(group)) call hdf5_close_group() +#elif MPI + +#else + +#endif + + end subroutine write_double + +!=============================================================================== +! WRITE_INTEGER_1Darray +!=============================================================================== + + subroutine write_double_1Darray(buffer, name, group, length) + + integer, intent(in) :: length + real(8), intent(in) :: buffer(:) + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_write_double_1Darray(temp_group, name, buffer, length) + if (present(group)) call hdf5_close_group() +#elif MPI + +#else + +#endif + + end subroutine write_double_1Darray !=============================================================================== ! WRITE_INTEGER @@ -130,6 +186,60 @@ contains end subroutine write_integer +!=============================================================================== +! WRITE_INTEGER_1Darray +!=============================================================================== + + subroutine write_integer_1Darray(buffer, name, group, length) + + integer, intent(in) :: length + integer, intent(in) :: buffer(:) + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_write_integer_1Darray(temp_group, name, buffer, length) + if (present(group)) call hdf5_close_group() +#elif MPI + +#else + +#endif + + end subroutine write_integer_1Darray + +!=============================================================================== +! WRITE_LONG +!=============================================================================== + + subroutine write_long(buffer, name, group) + + integer(8), intent(in) :: buffer + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_write_long(temp_group, name, buffer) + if (present(group)) call hdf5_close_group() +#elif MPI + +#else + +#endif + + end subroutine write_long + + !=============================================================================== ! WRITE_STRING !=============================================================================== diff --git a/src/state_point.F90 b/src/state_point.F90 index 207b6e7bf3..d5b4215996 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -2,9 +2,9 @@ module state_point use constants use global - use output, only: write_message + use output, only: write_message, time_stamp use string, only: to_str - use output_interface, only: file_create, write_data, file_close, write_string + use output_interface contains @@ -40,7 +40,36 @@ contains call write_data(VERSION_RELEASE, "version_release") ! Write current date and time - call write_string(time_stamp(), "date_and_time") + call write_data(time_stamp(), "date_and_time") + + ! Write path to input + call write_data(path_input, "path") + + ! Write out random number seed + call 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") + + ! Write out current batch number + call 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_batch, "k_batch", length=current_batch) + call write_data(entropy, "entropy", length=current_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) + end if + + ! Write number of meshes + call write_data(n_meshes, "n_meshes", "tallies") end if From cc590d78d3f46bc5e024464ef31d9cf01015b115 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 10 May 2013 15:24:51 -0700 Subject: [PATCH 11/65] implemented statepoint file writing for hdf5 --- src/hdf5_interface.F90 | 19 +--- src/output_interface.F90 | 140 +++++++++++++++++++++++++++- src/state_point.F90 | 191 ++++++++++++++++++++++++++++++++++++++- 3 files changed, 326 insertions(+), 24 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index c78988c420..67c0fc54f4 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -20,8 +20,8 @@ module hdf5_interface implicit none - integer(HID_T) :: hdf5_fh - integer(HID_T) :: temp_group + integer(HID_T) :: hdf5_fh + integer(HID_T) :: temp_group #ifdef HDF5 @@ -1315,19 +1315,6 @@ contains end subroutine hdf5_parallel_file_create -!=============================================================================== -! HDF5_PARALLEL_FILE_CLOSE -!=============================================================================== - - subroutine hdf5_parallel_file_close(file_id) - - integer(HID_T) :: file_id - - ! Close property list and the file - call h5fclose_f(file_id, hdf5_err) - - end subroutine hdf5_parallel_file_close - #endif !=============================================================================== @@ -1345,10 +1332,8 @@ contains ! Either create or open group if (status) then - print *,'OPENING GROUP' call h5gopen_f(hdf5_fh, trim(group), temp_group, hdf5_err) else - print *,'CREATING GROUP' call h5gcreate_f(hdf5_fh, trim(group), temp_group, hdf5_err) end if diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 3993d28cc2..2613237c53 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -1,6 +1,8 @@ module output_interface use constants + use global + use tally_header, only: TallyResult #ifdef HDF5 use hdf5_interface @@ -39,9 +41,10 @@ contains #ifdef HDF5 # ifdef MPI if (trim(fh_str) == 'state_point') then - if (master) call hdf5_file_create(trim(trim(filename) // '.h5'), & - hdf5_fh) + if(master) call hdf5_file_create(trim(trim(filename) // '.h5'), & + hdf5_fh) else + print *,'Opening source' call hdf5_parallel_file_create(trim(filename) // '.h5', & hdf5_fh) endif @@ -83,9 +86,9 @@ contains #ifdef HDF5 # ifdef MPI if (trim(fh_str) == 'state_point') then - if (master) call hdf5_file_close(hdf5_fh) + if(master) call hdf5_file_close(hdf5_fh) else - call hdf5_parallel_file_close(hdf5_fh) + call hdf5_file_close(hdf5_fh) endif # else call hdf5_file_close(hdf5_fh) @@ -266,4 +269,133 @@ contains end subroutine write_string +!=============================================================================== +! WRITE_GLOBAL_TALLIES +!=============================================================================== + + subroutine write_tally_result(buffer, name, group, length) + + character(*), intent(in), optional :: group + character(*), intent(in) :: name + integer, intent(in) :: length + type(TallyResult), intent(in) :: buffer(length) + + integer :: hdf5_err + integer(HSIZE_T) :: dims(1) + integer(HID_T) :: dspace + integer(HID_T) :: dset + type(c_ptr) :: f_ptr + +#ifdef HDF5 + + ! Open up sub-group if present + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + end if + + ! Set overall size of vector to write + dims(1) = length + + ! Create up a dataspace for size + call h5screate_simple_f(1, dims, dspace, hdf5_err) + + ! Create the dataset + call h5dcreate_f(temp_group, name, hdf5_tallyresult_t, dspace, dset, & + hdf5_err) + + ! Set pointer to first value and write + f_ptr = c_loc(buffer(1)) + call h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + + ! Close ids + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + if (present(group)) then + call hdf5_close_group() + end if + +#elif MPI + +#else + +#endif + + end subroutine write_tally_result + +!=============================================================================== +! WRITE_SOURCE_BANK +!=============================================================================== + + subroutine write_source_bank() + +#ifdef HDF5 + integer(HSIZE_T) :: dims(1) + integer(HID_T) :: dset + integer(HID_T) :: dspace + integer(HID_T) :: memspace + integer(HID_T) :: plist + integer :: rank + integer(8) :: offset(1) + type(c_ptr) :: f_ptr +#endif + +#ifdef HDF5 +# ifdef MPI + + ! Set size of total dataspace for all procs and rank + dims(1) = n_particles + rank = 1 + + ! Create that dataspace + call h5screate_simple_f(rank, dims, dspace, hdf5_err) + + ! Create the dataset for that dataspace + call h5dcreate_f(hdf5_fh, "source", hdf5_bank_t, dspace, dset, hdf5_err) + + ! Close the dataspace + call h5sclose_f(dspace, hdf5_err) + + ! Create another data space but for each proc individually + dims(1) = work + call h5screate_simple_f(rank, dims, memspace, hdf5_err) + + ! Get the individual local proc dataspace + call h5dget_space_f(dset, dspace, hdf5_err) + + ! Select hyperslab for this dataspace + offset(1) = bank_first - 1_8 + call h5sselect_hyperslab_f(dspace, H5S_SELECT_SET_F, offset, dims, hdf5_err) + + ! Set up the property list for parallel writing + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + + ! Set up pointer to data + f_ptr = c_loc(source_bank(1)) + + ! Write data to file in parallel + call h5dwrite_f(dset, hdf5_bank_t, f_ptr, hdf5_err, & + file_space_id = dspace, mem_space_id = memspace, & + xfer_prp = plist) + + ! Close all ids + call h5sclose_f(dspace, hdf5_err) + call h5sclose_f(memspace, hdf5_err) + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + +# else + +# endif + +#elif MPI + +#else + +#endif + + end subroutine write_source_bank + end module output_interface diff --git a/src/state_point.F90 b/src/state_point.F90 index d5b4215996..6f05615dda 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -5,6 +5,9 @@ module state_point use output, only: write_message, time_stamp use string, only: to_str use output_interface + use tally_header, only: TallyObject + + implicit none contains @@ -17,6 +20,10 @@ contains character(MAX_FILE_LEN) :: filename character(MAX_WORD_LEN) :: fh_state_point = "state_point" character(MAX_WORD_LEN) :: fh_source = "source" + integer :: i + integer :: j + integer, allocatable :: temp_array(:) + type(TallyObject), pointer :: t => null() ! Set filename for state point filename = trim(path_output) // 'statepoint.' // & @@ -69,12 +76,190 @@ contains end if ! Write number of meshes - call write_data(n_meshes, "n_meshes", "tallies") + call 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", & + group="tallies/mesh" // to_str(i)) + call write_data(meshes(i) % type, "type", & + group="tallies/mesh" // to_str(i)) + call write_data(meshes(i) % n_dimension, "n_dimension", & + group="tallies/mesh" // to_str(i)) + call 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", & + group="tallies/mesh" // to_str(i), & + length=meshes(i) % n_dimension) + call 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", & + 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") + + ! Write all tally information except results + TALLY_METADATA: do i = 1, n_tallies + !Get pointer to tally + t => tallies(i) + + ! Write id + call write_data(t % id, "id", group="tallies/tally" // to_str(i)) + + ! Write number of realizations + call 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", & + group="tallies/tally" // to_str(i)) + call 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", & + 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", & + 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", & + 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", & + 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", & + group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j), & + length=size(t % filters(j) % int_bins)) + end if + + end do FILTER_LOOP + + ! Write number of nuclide bins + call write_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)) + NUCLIDE_LOOP: do j = 1, t % n_nuclide_bins + if (t % nuclide_bins(j) > 0) then + temp_array(j) = nuclides(t % nuclide_bins(j)) % zaid + else + temp_array(j) = t % nuclide_bins(j) + end if + end do NUCLIDE_LOOP + call 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", & + group="tallies/tally" // to_str(i)) + call 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", & + group="tallies/tally" // to_str(i), length=t % n_score_bins) + + ! Write number of user socre bins + call write_data(t % n_user_score_bins, "n_user_score_bins", & + group="tallies/tally" // to_str(i)) + + end do TALLY_METADATA end if - ! Close statepoint file - call file_close(fh_state_point) + ! Check for the no-tally-reduction method + if (.not. reduce_tallies) then + + ! TODO Call the no tally reduce routine + + elseif (master) then + + ! Write number of global realizations + call 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", & + length=N_GLOBAL_TALLIES) + + ! Write tallies + if (tallies_on) then + + ! Indicate that tallies are on + call write_data(1, "tallies_present") + + ! Write all tally results + TALLY_RESULTS: do i = 1, n_tallies + + ! Set point to current tally + t => tallies(i) + + ! Write sum and sum_sq for each bin + call write_tally_result(t % results, "results", & + group="tallies/tally" // to_str(i), & + length=size(t % results, 1) * size(t % results, 2)) + + end do TALLY_RESULTS + + else + + ! Indicate tallies are off + call write_data(0, "tallies_present") + + end if + + end if + + ! Change file handles if source is separately written +#ifdef HDF5 +# ifdef MPI + source_separate = .true. +# endif +#endif + + if (source_separate) then + + ! Close statepoint file + call file_close(fh_state_point) + + ! Set filename for source + filename = trim(path_output) // 'source.' // & + trim(to_str(current_batch)) + + ! Write message + message = "Creating source file " // trim(filename) // "..." + call write_message(1) + + ! Create statepoint file + call file_create(filename, fh_source) + + end if + + ! Write out source + call write_source_bank() + + ! Close file + if (source_separate) then + call file_close(fh_source) + else + call file_close(fh_state_point) + end if end subroutine write_state_point From b9c3e9441dc3e54784592057125b8c610acb7972 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Sat, 11 May 2013 10:12:53 -0700 Subject: [PATCH 12/65] added MPI and serial writing, and cleaned up hdf5 --- src/constants.F90 | 1 + src/hdf5_interface.F90 | 7 +-- src/mpi_interface.F90 | 114 +++++++++++++++++++++++++++++----- src/output_interface.F90 | 130 +++++++++++++++++++++++++++++---------- src/state_point.F90 | 8 +-- 5 files changed, 202 insertions(+), 58 deletions(-) diff --git a/src/constants.F90 b/src/constants.F90 index 04f757db9c..5700bd9084 100644 --- a/src/constants.F90 +++ b/src/constants.F90 @@ -360,6 +360,7 @@ module constants integer, parameter :: UNIT_STATE = 16 ! unit # for writing state point integer, parameter :: CMFD_BALANCE = 17 ! unit # for writing cmfd balance file integer, parameter :: UNIT_PARTICLE = 18 ! unit # for writing particle restart + integer, parameter :: UNIT_OUTPUT = 19 ! unit # for writing output files !============================================================================= ! CMFD CONSTANTS diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 67c0fc54f4..c70e2e8436 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -16,14 +16,11 @@ module hdf5_interface use hdf5 use h5lt use, intrinsic :: ISO_C_BINDING -#endif implicit none - integer(HID_T) :: hdf5_fh - integer(HID_T) :: temp_group - -#ifdef HDF5 + integer(HID_T) :: hdf5_fh + integer(HID_T) :: temp_group contains diff --git a/src/mpi_interface.F90 b/src/mpi_interface.F90 index 9d18a83ce3..d7c47d895a 100644 --- a/src/mpi_interface.F90 +++ b/src/mpi_interface.F90 @@ -1,22 +1,15 @@ module mpi_interface use constants + use global #ifdef MPI use mpi -#endif + implicit none - ! define array writing interface -! interface mpi_write_data -! module procedure mpi_write_integer -! module procedure mpi_write_double -! module procedure mpi_write_double_1Darray -! module procedure mpi_write_integer_1Darray -! end interface mpi_write_data - - integer :: mpi_err +! integer :: mpi_fh contains @@ -24,14 +17,14 @@ contains ! MPI_FILE_CREATE !=============================================================================== - subroutine mpi_file_create(filename, file_id) + subroutine mpi_file_create(filename, fh) - character(MAX_FILE_LEN) :: filename - integer :: file_id + character(*) :: filename + integer, intent(in) :: fh ! Create the file call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, MPI_MODE_CREATE + & - MPI_MODE_WRONLY, MPI_INFO_NULL, file_id, mpi_err) + MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpi_err) end subroutine mpi_file_create @@ -39,12 +32,99 @@ contains ! MPI_CLOSE_FILE !=============================================================================== - subroutine mpi_close_file(file_id) + subroutine mpi_close_file(fh) - integer :: file_id + integer, intent(in) :: fh - call MPI_FILE_CLOSE(file_id, mpi_err) + call MPI_FILE_CLOSE(fh, mpi_err) end subroutine mpi_close_file +!=============================================================================== +! MPI_WRITE_INTEGER +!=============================================================================== + + subroutine mpi_write_integer(fh, buffer) + + integer, intent(in) :: fh + integer, intent(in) :: buffer + + call MPI_FILE_WRITE(fh, buffer, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + + end subroutine mpi_write_integer + +!=============================================================================== +! MPI_WRITE_INTEGER_1DARRAY +!=============================================================================== + + subroutine mpi_write_integer_1Darray(fh, buffer, length) + + integer, intent(in) :: fh + integer, intent(in) :: length + integer, intent(in) :: buffer(:) + + call MPI_FILE_WRITE(fh, buffer, length, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + + end subroutine mpi_write_integer_1Darray + +!=============================================================================== +! MPI_WRITE_LONG +!=============================================================================== + + subroutine mpi_write_long(fh, buffer) + + integer, intent(in) :: fh + integer(8), intent(in) :: buffer + + call MPI_FILE_WRITE(fh, buffer, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpi_err) + + end subroutine mpi_write_long + +!=============================================================================== +! MPI_WRITE_DOUBLE +!=============================================================================== + + subroutine mpi_write_double(fh, buffer) + + integer, intent(in) :: fh + real(8), intent(in) :: buffer + + call MPI_FILE_WRITE(fh, buffer, 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + + end subroutine mpi_write_double + +!=============================================================================== +! MPI_WRITE_DOUBLE_1DARRAY +!=============================================================================== + + subroutine mpi_write_double_1Darray(fh, buffer, length) + + integer, intent(in) :: fh + integer, intent(in) :: length + real(8), intent(in) :: buffer(:) + + call MPI_FILE_WRITE(fh, buffer, length, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + + end subroutine mpi_write_double_1Darray + +!=============================================================================== +! MPI_WRITE_STRING +!=============================================================================== + + subroutine mpi_write_string(fh, buffer, length) + + character(*), intent(in) :: buffer + integer, intent(in) :: fh + integer, intent(in) :: length + + call MPI_FILE_WRITE(fh, buffer, length, MPI_CHARACTER, & + MPI_STATUS_IGNORE, mpi_err) + + end subroutine mpi_write_string +#endif end module mpi_interface diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 2613237c53..e3e7e4c84d 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -12,10 +12,7 @@ module output_interface implicit none -#if MPI - integer :: fh_state_point ! mpi file for state point - integer :: fh_source ! mpi file for source -#endif + integer :: mpi_fh interface write_data module procedure write_double @@ -35,7 +32,7 @@ contains subroutine file_create(filename, fh_str) - character(MAX_FILE_LEN) :: filename + character(*) :: filename character(MAX_WORD_LEN) :: fh_str #ifdef HDF5 @@ -44,7 +41,6 @@ contains if(master) call hdf5_file_create(trim(trim(filename) // '.h5'), & hdf5_fh) else - print *,'Opening source' call hdf5_parallel_file_create(trim(filename) // '.h5', & hdf5_fh) endif @@ -59,16 +55,16 @@ contains # endif #elif MPI if (trim(fh_str) == 'state_point') then - call mpi_file_create(trim(filename) // '.binary/' , fh_state_point) + call mpi_file_create(trim(filename) // '.binary' , mpi_fh) else - call mpi_file_create(trim(filename) // '.binary', fh_source) + call mpi_file_create(trim(filename) // '.binary', mpi_fh) endif #else if (trim(fh_str) == 'state_point') then - open(UNIT=UNIT_STATE, FILE=trim(filename) // '.binary', STATUS='replace', & + open(UNIT=UNIT_OUTPUT, FILE=trim(filename) // '.binary', STATUS='replace', & ACCESS='stream') else - open(UNIT=UNIT_SOURCE, FILE=trim(filename) // '.binary', STATUS='replace', & + open(UNIT=UNIT_OUTPUT, FILE=trim(filename) // '.binary', STATUS='replace', & ACCESS='stream') endif #endif @@ -92,19 +88,18 @@ contains endif # else call hdf5_file_close(hdf5_fh) - endif # endif #elif MPI if (trim(fh_str) == 'state_point') then - call mpi_close_file(fh_state_point) + call mpi_close_file(mpi_fh) else - call mpi_close_file(fh_source) + call mpi_close_file(mpi_fh) endif #else if (trim(fh_str) == 'state_point') then - close(UNIT=UNIT_STATE) + close(UNIT=UNIT_OUTPUT) else - close(UNIT=UNIT_SOURCE) + close(UNIT=UNIT_OUTPUT) endif #endif @@ -129,9 +124,9 @@ contains call hdf5_write_double(temp_group, name, buffer) if (present(group)) call hdf5_close_group() #elif MPI - + call mpi_write_double(mpi_fh, buffer) #else - + write(UNIT_OUTPUT) buffer #endif end subroutine write_double @@ -156,9 +151,9 @@ contains call hdf5_write_double_1Darray(temp_group, name, buffer, length) if (present(group)) call hdf5_close_group() #elif MPI - + call mpi_write_double_1Darray(mpi_fh, buffer, length) #else - + write(UNIT_OUTPUT) buffer(1:length) #endif end subroutine write_double_1Darray @@ -182,9 +177,9 @@ contains call hdf5_write_integer(temp_group, name, buffer) 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 @@ -209,9 +204,9 @@ contains call hdf5_write_integer_1Darray(temp_group, name, buffer, length) if (present(group)) call hdf5_close_group() #elif MPI - + call mpi_write_integer_1Darray(mpi_fh, buffer, length) #else - + write(UNIT_OUTPUT) buffer(1:length) #endif end subroutine write_integer_1Darray @@ -235,9 +230,9 @@ contains call hdf5_write_long(temp_group, name, buffer) if (present(group)) call hdf5_close_group() #elif MPI - + call mpi_write_long(mpi_fh, buffer) #else - + write(UNIT_OUTPUT) buffer #endif end subroutine write_long @@ -253,6 +248,12 @@ contains character(*), intent(in) :: name character(*), intent(in), optional :: group +#ifndef HDF5 +# ifdef MPI + integer :: n +# endif +#endif + #ifdef HDF5 if (present(group)) then call hdf5_open_group(group) @@ -262,9 +263,10 @@ contains call hdf5_write_string(temp_group, name, buffer) if (present(group)) call hdf5_close_group() #elif MPI - + n = len(buffer) + call mpi_write_string(mpi_fh, buffer, n) #else - + write(UNIT_OUTPUT) buffer #endif end subroutine write_string @@ -273,18 +275,23 @@ contains ! WRITE_GLOBAL_TALLIES !=============================================================================== - subroutine write_tally_result(buffer, name, group, length) + subroutine write_tally_result(buffer, name, group, n1, n2) character(*), intent(in), optional :: group character(*), intent(in) :: name - integer, intent(in) :: length - type(TallyResult), intent(in) :: buffer(length) + integer, intent(in) :: n1, n2 + type(TallyResult), intent(in) :: buffer(n1, n2) +#ifdef HDF5 integer :: hdf5_err integer(HSIZE_T) :: dims(1) integer(HID_T) :: dspace integer(HID_T) :: dset type(c_ptr) :: f_ptr +#elif MPI +#else + integer :: j,k +#endif #ifdef HDF5 @@ -296,7 +303,7 @@ contains end if ! Set overall size of vector to write - dims(1) = length + dims(1) = n1*n2 ! Create up a dataspace for size call h5screate_simple_f(1, dims, dspace, hdf5_err) @@ -318,8 +325,20 @@ contains #elif MPI + ! Write out tally buffer + call MPI_FILE_WRITE(mpi_fh, buffer, n1*n2, MPI_TALLYRESULT, & + MPI_STATUS_IGNORE, mpi_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 + end do + end do + #endif end subroutine write_tally_result @@ -339,6 +358,10 @@ contains integer :: rank integer(8) :: offset(1) type(c_ptr) :: f_ptr +#elif MPI + integer(MPI_OFFSET_KIND) :: offset + integer :: size_offset_kind + integer :: size_bank #endif #ifdef HDF5 @@ -352,7 +375,7 @@ contains call h5screate_simple_f(rank, dims, dspace, hdf5_err) ! Create the dataset for that dataspace - call h5dcreate_f(hdf5_fh, "source", hdf5_bank_t, dspace, dset, hdf5_err) + call h5dcreate_f(hdf5_fh, "source_bank", hdf5_bank_t, dspace, dset, hdf5_err) ! Close the dataspace call h5sclose_f(dspace, hdf5_err) @@ -388,12 +411,55 @@ contains # else + ! Set size + dims(1) = work + + ! Create dataspace + call h5screate_simple_f(1, dims, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(hdf5_fh, "source_bank", hdf5_bank_t, & + dspace, dset, hdf5_err) + + ! Set up pointer to data + f_ptr = c_loc(source_bank(1)) + + ! Write dataset to file + call h5dwrite_f(dset, hdf5_bank_t, f_ptr, hdf5_err) + + ! Close all ids + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + # endif #elif MPI + ! Get current offset for master + if (master) call MPI_FILE_GET_POSITION(mpi_fh, offset, mpi_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 + + ! 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 + call MPI_FILE_WRITE_AT(mpi_fh, offset, source_bank(1), work, MPI_BANK, & + MPI_STATUS_IGNORE, mpi_err) + #else + ! Write out source sites + write(UNIT_OUTPUT) source_bank + #endif end subroutine write_source_bank diff --git a/src/state_point.F90 b/src/state_point.F90 index 6f05615dda..778edb9a36 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -196,13 +196,13 @@ contains ! Write global tallies call write_data(N_GLOBAL_TALLIES, "n_global_tallies") call write_tally_result(global_tallies, "global_tallies", & - length=N_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") + call write_data(1, "tallies_present", group="tallies") ! Write all tally results TALLY_RESULTS: do i = 1, n_tallies @@ -213,14 +213,14 @@ contains ! Write sum and sum_sq for each bin call write_tally_result(t % results, "results", & group="tallies/tally" // to_str(i), & - length=size(t % results, 1) * size(t % results, 2)) + n1=size(t % results, 1), n2=size(t % results, 2)) end do TALLY_RESULTS else ! Indicate tallies are off - call write_data(0, "tallies_present") + call write_data(0, "tallies_present", group="tallies") end if From 1ef85335360390bc7d16630e37f3cdae9e034809 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Sat, 11 May 2013 14:57:31 -0700 Subject: [PATCH 13/65] hdf5 can now be restarted in parallel and replay batch history added back in --- src/hdf5_interface.F90 | 88 +++++++++ src/output_interface.F90 | 405 ++++++++++++++++++++++++++++++++++++++- src/state_point.F90 | 395 ++++++++++++++++++++++++++++++++++---- 3 files changed, 849 insertions(+), 39 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index c70e2e8436..7ff2d67b8a 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -1274,6 +1274,20 @@ contains end subroutine hdf5_file_create +!=============================================================================== +! HDF5_FILE_OPEN +!=============================================================================== + + subroutine hdf5_file_open(filename, file_id) + + character(MAX_FILE_LEN) :: filename + integer(HID_T) :: file_id + + ! Create the file + call h5fopen_f(trim(filename), H5F_ACC_RDONLY_F, file_id, hdf5_err) + + end subroutine hdf5_file_open + !=============================================================================== ! HDF5_FILE_CLOSE !=============================================================================== @@ -1312,6 +1326,29 @@ contains end subroutine hdf5_parallel_file_create +!=============================================================================== +! HDF5_PARALLEL_FILE_OPEN +!=============================================================================== + + subroutine hdf5_parallel_file_open(filename, file_id) + + character(MAX_FILE_LEN) :: filename + integer(HID_T) :: file_id + integer(HID_T) :: plist_id + + ! Setup file access property list with parallel I/O access + call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) + call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) + + ! Create the file collectively + call h5fopen_f(trim(filename), H5F_ACC_RDONLY_F, file_id, hdf5_err, & + access_prp = plist_id) + + ! Close the property list + call h5pclose_f(plist_id, hdf5_err) + + end subroutine hdf5_parallel_file_open + #endif !=============================================================================== @@ -1488,6 +1525,25 @@ contains end subroutine hdf5_read_integer +!=============================================================================== +! HDF5_READ_INTEGER_1DARRAY +!=============================================================================== + + subroutine hdf5_read_integer_1Darray(group, name, buffer, length) + + integer(HID_T), intent(in) :: group + character(*), intent(in) :: name + integer, intent(inout) :: buffer(:) + integer, intent(in) :: length + + integer(HSIZE_T) :: dims(1) + + dims(1) = length + call h5ltread_dataset_int_f(group, name, buffer, dims, hdf5_err) + + end subroutine hdf5_read_integer_1Darray + + !=============================================================================== ! HDF5_READ_LONG !=============================================================================== @@ -1533,6 +1589,38 @@ contains end subroutine hdf5_read_double +!=============================================================================== +! HDF5_READ_DOUBLE_1DARRAY +!=============================================================================== + + subroutine hdf5_read_double_1Darray(group, name, buffer, length) + + integer(HID_T), intent(in) :: group + integer, intent(in) :: length + character(*), intent(in) :: name + real(8), intent(out) :: buffer(:) + + integer(HSIZE_T) :: dims(1) + + dims(1) = length + call h5ltread_dataset_double_f(group, name, buffer, dims, hdf5_err) + + end subroutine hdf5_read_double_1Darray + +!=============================================================================== +! HDF5_READ_STRING +!=============================================================================== + + subroutine hdf5_read_string(group, name, buffer) + + integer(HID_T), intent(in) :: group + character(*), intent(in) :: name + character(*), intent(inout) :: buffer + + call h5ltread_dataset_string_f(group, name, buffer, hdf5_err) + + end subroutine hdf5_read_string + #endif end module hdf5_interface diff --git a/src/output_interface.F90 b/src/output_interface.F90 index e3e7e4c84d..2d456717a3 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -23,6 +23,14 @@ module output_interface module procedure write_string end interface write_data + interface read_data + module procedure read_double + module procedure read_double_1Darray + module procedure read_integer + module procedure read_integer_1Darray + module procedure read_long + module procedure read_string + end interface read_data contains @@ -71,6 +79,51 @@ contains end subroutine file_create +!=============================================================================== +! FILE_OPEN +!=============================================================================== + + subroutine file_open(filename, fh_str) + + character(*) :: filename + character(MAX_WORD_LEN) :: fh_str + +#ifdef HDF5 +# ifdef MPI + if (trim(fh_str) == 'state_point') then + call hdf5_file_open(trim(trim(filename) // '.h5'), & + hdf5_fh) + else + call hdf5_parallel_file_open(trim(filename) // '.h5', & + hdf5_fh) + endif +# else + if (trim(fh_str) == 'state_point') then + call hdf5_file_open(trim(filename) // '.h5', & + hdf5_fh) + else + call hdf5_file_open(trim(filename) // '.h5', & + hdf5_fh) + endif +# endif +#elif MPI + if (trim(fh_str) == 'state_point') then + call mpi_file_open(trim(filename) // '.binary' , mpi_fh) + else + call mpi_file_open(trim(filename) // '.binary', mpi_fh) + endif +#else + if (trim(fh_str) == 'state_point') then + open(UNIT=UNIT_OUTPUT, FILE=trim(filename) // '.binary', STATUS='old', & + ACCESS='stream') + else + open(UNIT=UNIT_OUTPUT, FILE=trim(filename) // '.binary', STATUS='old', & + ACCESS='stream') + endif +#endif + + end subroutine file_open + !=============================================================================== ! FILE_CLOSE !=============================================================================== @@ -106,7 +159,7 @@ contains end subroutine file_close !=============================================================================== -! WRITE_INTEGER +! WRITE_DOUBLE !=============================================================================== subroutine write_double(buffer, name, group) @@ -132,7 +185,33 @@ contains end subroutine write_double !=============================================================================== -! WRITE_INTEGER_1Darray +! READ_INTEGER +!=============================================================================== + + subroutine read_double(buffer, name, group) + + real(8), intent(inout) :: buffer + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_read_double(temp_group, name, buffer) + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_read_double(mpi_fh, buffer) +#else + read(UNIT_OUTPUT) buffer +#endif + + end subroutine read_double + +!=============================================================================== +! WRITE_DOUBLE_1DARRAY !=============================================================================== subroutine write_double_1Darray(buffer, name, group, length) @@ -158,6 +237,33 @@ contains end subroutine write_double_1Darray +!=============================================================================== +! READ_DOUBLE_1DARRAY +!=============================================================================== + + subroutine read_double_1Darray(buffer, name, group, length) + + integer, intent(in) :: length + real(8), intent(inout) :: buffer(:) + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_read_double_1Darray(temp_group, name, buffer, length) + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_read_double_1Darray(mpi_fh, buffer, length) +#else + read(UNIT_OUTPUT) buffer(1:length) +#endif + + end subroutine read_double_1Darray + !=============================================================================== ! WRITE_INTEGER !=============================================================================== @@ -185,7 +291,33 @@ contains end subroutine write_integer !=============================================================================== -! WRITE_INTEGER_1Darray +! READ_INTEGER +!=============================================================================== + + subroutine read_integer(buffer, name, group) + + integer, intent(inout) :: buffer + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_read_integer(temp_group, name, buffer) + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_read_integer(mpi_fh, buffer) +#else + read(UNIT_OUTPUT) buffer +#endif + + end subroutine read_integer + +!=============================================================================== +! WRITE_INTEGER_1DARRAY !=============================================================================== subroutine write_integer_1Darray(buffer, name, group, length) @@ -211,6 +343,33 @@ contains end subroutine write_integer_1Darray +!=============================================================================== +! READ_INTEGER_1DARRAY +!=============================================================================== + + subroutine read_integer_1Darray(buffer, name, group, length) + + integer, intent(in) :: length + integer, intent(inout) :: buffer(:) + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_read_integer_1Darray(temp_group, name, buffer, length) + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_read_integer_1Darray(mpi_fh, buffer, length) +#else + read(UNIT_OUTPUT) buffer(1:length) +#endif + + end subroutine read_integer_1Darray + !=============================================================================== ! WRITE_LONG !=============================================================================== @@ -237,6 +396,31 @@ contains end subroutine write_long +!=============================================================================== +! READ_LONG +!=============================================================================== + + subroutine read_long(buffer, name, group) + + integer(8), intent(inout) :: buffer + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_read_long(temp_group, name, buffer) + if (present(group)) call hdf5_close_group() +#elif MPI + call mpi_read_long(mpi_fh, buffer) +#else + write(UNIT_OUTPUT) buffer +#endif + + end subroutine read_long !=============================================================================== ! WRITE_STRING @@ -272,7 +456,40 @@ contains end subroutine write_string !=============================================================================== -! WRITE_GLOBAL_TALLIES +! WRITE_STRING +!=============================================================================== + + subroutine read_string(buffer, name, group) + + character(*), intent(inout) :: buffer + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifndef HDF5 +# ifdef MPI + integer :: n +# endif +#endif + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_read_string(temp_group, name, buffer) + if (present(group)) call hdf5_close_group() +#elif MPI + n = len(buffer) + call mpi_read_string(mpi_fh, buffer, n) +#else + read(UNIT_OUTPUT) buffer +#endif + + end subroutine read_string + +!=============================================================================== +! WRITE_TALLY_RESULT !=============================================================================== subroutine write_tally_result(buffer, name, group, n1, n2) @@ -313,7 +530,7 @@ contains hdf5_err) ! Set pointer to first value and write - f_ptr = c_loc(buffer(1)) + f_ptr = c_loc(buffer(1,1)) call h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) ! Close ids @@ -343,6 +560,74 @@ contains end subroutine write_tally_result +!=============================================================================== +! READ_TALLY_RESULT +!=============================================================================== + + subroutine read_tally_result(buffer, name, group, n1, n2) + + character(*), intent(in), optional :: group + character(*), intent(in) :: name + integer, intent(in) :: n1, n2 + type(TallyResult), intent(in) :: buffer(n1, n2) + +#ifdef HDF5 + integer :: hdf5_err + integer(HSIZE_T) :: dims(1) + integer(HID_T) :: dspace + integer(HID_T) :: dset + type(c_ptr) :: f_ptr +#elif MPI +#else + integer :: j,k +#endif + +#ifdef HDF5 + + ! Open up sub-group if present + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + end if + + ! Set overall size of vector to read + dims(1) = n1*n2 + + ! Open the dataset + call h5dopen_f(temp_group, name, dset, hdf5_err) + + ! Set pointer to first value and write + f_ptr = c_loc(buffer(1,1)) + call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + + ! Close ids + call h5dclose_f(dset, hdf5_err) + if (present(group)) then + call hdf5_close_group() + end if + +#elif MPI + + ! Write out tally buffer + call MPI_FILE_READ(mpi_fh, buffer, n1*n2, MPI_TALLYRESULT, & + MPI_STATUS_IGNORE, mpi_err) + +#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 + end do + end do + +#endif + + end subroutine read_tally_result + + !=============================================================================== ! WRITE_SOURCE_BANK !=============================================================================== @@ -464,4 +749,114 @@ contains end subroutine write_source_bank +!=============================================================================== +! READ_SOURCE_BANK +!=============================================================================== + + subroutine read_source_bank() + +#ifdef HDF5 + integer(HSIZE_T) :: dims(1) + integer(HID_T) :: dset + integer(HID_T) :: dspace + integer(HID_T) :: memspace + integer(HID_T) :: plist + integer :: rank + integer(8) :: offset(1) + type(c_ptr) :: f_ptr +#elif MPI + integer(MPI_OFFSET_KIND) :: offset + integer :: size_offset_kind + integer :: size_bank +#endif + +#ifdef HDF5 +# ifdef MPI + + ! Set size of total dataspace for all procs and rank + dims(1) = n_particles + rank = 1 + + ! Open the dataset + call h5dopen_f(hdf5_fh, "source_bank", dset, hdf5_err) + + ! Create another data space but for each proc individually + dims(1) = work + call h5screate_simple_f(rank, dims, memspace, hdf5_err) + + ! Get the individual local proc dataspace + call h5dget_space_f(dset, dspace, hdf5_err) + + ! Select hyperslab for this dataspace + offset(1) = bank_first - 1_8 + call h5sselect_hyperslab_f(dspace, H5S_SELECT_SET_F, offset, dims, hdf5_err) + + ! Set up the property list for parallel writing + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) + + ! Set up pointer to data + f_ptr = c_loc(source_bank(1)) + + ! Read data from file in parallel + call h5dread_f(dset, hdf5_bank_t, f_ptr, hdf5_err, & + file_space_id = dspace, mem_space_id = memspace, & + xfer_prp = plist) + + ! Close all ids + call h5sclose_f(dspace, hdf5_err) + call h5sclose_f(memspace, hdf5_err) + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + +# else + + ! Set size + dims(1) = work + + ! Open dataset + call h5dcreate_f(hdf5_fh, "source_bank", dset, hdf5_err) + + ! Set up pointer to data + f_ptr = c_loc(source_bank(1)) + + ! Read dataset from file + call h5dread_f(dset, hdf5_bank_t, f_ptr, hdf5_err) + + ! Close all ids + call h5dclose_f(dset, hdf5_err) + +# endif + +#elif MPI + + ! Get current offset for master + if (master) call MPI_FILE_GET_POSITION(mpi_fh, offset, mpi_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 + + ! 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 + call MPI_FILE_READ_AT(mpi_fh, offset, source_bank(1), work, MPI_BANK, & + MPI_STATUS_IGNORE, mpi_err) + +#else + + ! Write out source sites + read(UNIT_OUTPUT) source_bank + +#endif + + end subroutine read_source_bank + end module output_interface diff --git a/src/state_point.F90 b/src/state_point.F90 index 778edb9a36..65321a34d1 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -1,8 +1,22 @@ module state_point +!=============================================================================== +! STATE_POINT -- This module handles writing and reading state point +! files. State points are contain complete tally results, source sites, and +! various other data. They can be used to restart a run or to reconstruct +! confidence intervals for tallies (this requires post-processing via Python +! scripts). +! +! State points can be written at any batch during a simulation, or at specified +! intervals, using the tag. +!=============================================================================== + + use constants + use error, only: fatal_error, warning use global - use output, only: write_message, time_stamp + use output, only: write_message, time_stamp, print_batch_keff + use math, only: t_percentile use string, only: to_str use output_interface use tally_header, only: TallyObject @@ -68,7 +82,7 @@ contains call write_data(n_inactive, "n_inactive") call write_data(gen_per_batch, "gen_per_batch") call write_data(k_batch, "k_batch", length=current_batch) - call write_data(entropy, "entropy", length=current_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") @@ -175,7 +189,7 @@ contains call write_data(t % scatt_order, "scatt_order", & group="tallies/tally" // to_str(i), length=t % n_score_bins) - ! Write number of user socre bins + ! Write number of user score bins call write_data(t % n_user_score_bins, "n_user_score_bins", & group="tallies/tally" // to_str(i)) @@ -226,39 +240,49 @@ contains end if - ! Change file handles if source is separately written + ! Check for eigenvalue calculation + if (run_mode == MODE_EIGENVALUE .and. source_write) then + + ! Change file handles if source is separately written #ifdef HDF5 # ifdef MPI - source_separate = .true. + source_separate = .true. # endif #endif - if (source_separate) then + if (source_separate) then - ! Close statepoint file - call file_close(fh_state_point) + ! Close statepoint file + call file_close(fh_state_point) - ! Set filename for source - filename = trim(path_output) // 'source.' // & - trim(to_str(current_batch)) + ! Set filename for source + filename = trim(path_output) // 'source.' // & + trim(to_str(current_batch)) - ! Write message - message = "Creating source file " // trim(filename) // "..." - call write_message(1) + ! Write message + message = "Creating source file " // trim(filename) // "..." + call write_message(1) - ! Create statepoint file - call file_create(filename, fh_source) + ! Create statepoint file + call file_create(filename, fh_source) - end if + end if - ! Write out source - call write_source_bank() + ! Write out source + call write_source_bank() + + ! Close file + if (source_separate) then + call file_close(fh_source) + else + call file_close(fh_state_point) + end if - ! Close file - if (source_separate) then - call file_close(fh_source) else + + ! Close file if not in eigenvalue mode or no source writing call file_close(fh_state_point) + end if end subroutine write_state_point @@ -269,30 +293,333 @@ contains subroutine load_state_point() + character(MAX_FILE_LEN) :: filename + character(MAX_FILE_LEN) :: path_temp + character(MAX_WORD_LEN) :: fh_state_point = "state_point" + character(MAX_WORD_LEN) :: fh_source = "source" + character(19) :: current_time + integer :: i + integer :: j + integer :: int_array(3) + integer, allocatable :: temp_array(:) + real(8) :: real_array(3) + type(TallyObject), pointer :: t => null() + + ! Write message + message = "Loading state point " // trim(path_state_point) // "..." + call write_message(1) + + ! Open file for reading + call file_open(path_state_point, fh_state_point) + + ! Read revision number for state point file and make sure it matches with + ! current version + call read_data(int_array(1), "revision_statepoint") + if (int_array(1) /= REVISION_STATEPOINT) then + message = "State point version does not match current version " & + // "in OpenMC." + call fatal_error() + end if + + ! Read OpenMC version + call read_data(int_array(1), "version_major") + call read_data(int_array(2), "version_minor") + call 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 " & + // "of OpenMC." + call warning() + end if + + ! Read date and time + call read_data(current_time, "date_and_time") + + ! Read path to input + call read_data(path_temp, "path") + + ! Read and overwrite random number seed + call read_data(seed, "seed") + + ! Read and overwrite run information except number of batches + call read_data(run_mode, "run_mode") + call read_data(n_particles, "n_particles") + call 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") + + ! Read information specific to eigenvalue run + if (run_mode == MODE_EIGENVALUE) then + call read_data(int_array(1), "n_inactive") + call read_data(gen_per_batch, "gen_per_batch") + call read_data(k_batch, "k_batch", length=restart_batch) + call read_data(entropy, "entropy", length=restart_batch*gen_per_batch) + call read_data(k_col_abs, "k_col_abs") + call read_data(k_col_tra, "k_col_tra") + call read_data(k_abs_tra, "k_abs_tra") + call 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") + + ! 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)) + call read_data(meshes(i) % type, "type", & + group="tallies/mesh" // to_str(i)) + call read_data(meshes(i) % n_dimension, "n_dimension", & + group="tallies/mesh" // to_str(i)) + call read_data(meshes(i) % dimension, "dimension", & + group="tallies/mesh" // to_str(i), & + length=meshes(i) % n_dimension) + call read_data(meshes(i) % lower_left, "lower_left", & + group="tallies/mesh" // to_str(i), & + length=meshes(i) % n_dimension) + call read_data(meshes(i) % upper_right, "upper_right", & + group="tallies/mesh" // to_str(i), & + length=meshes(i) % n_dimension) + call read_data(meshes(i) % width, "width", & + group="tallies/mesh" // to_str(i), & + length=meshes(i) % n_dimension) + end do MESH_LOOP + + ! Read and overwrite number of tallies + call read_data(n_tallies, "n_tallies", group="tallies") + + ! Read in tally metadata + TALLY_METADATA: do i = 1, n_tallies + + ! Get pointer to tally + t => tallies(i) + + ! Read tally id + call 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)) + + ! Read size of tally results + call read_data(int_array(1), "total_score_bins", & + group="tallies/tally" // to_str(i)) + call 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. & + int_array(2) /= t % total_filter_bins) then + message = "Input file tally structure is different from restart." + call fatal_error() + end if + + ! Read number of filters + call 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)) + + ! 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)) + + ! 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", & + group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j), & + length=size(t % filters(j) % real_bins)) + else + call 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)) + 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)) + + ! 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) + NUCLIDE_LOOP: do j = 1, t % n_nuclide_bins + if (temp_array(j) > 0) then + nuclides(t % nuclide_bins(j)) % zaid = temp_array(j) + else + t % nuclide_bins(j) = temp_array(j) + end if + end do NUCLIDE_LOOP + 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)) + call read_data(t % score_bins, "score_bins", & + group="tallies/tally" // to_str(i), length=t % n_score_bins) + call 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)) + + end do TALLY_METADATA + + ! Read tallies to master + if (master) then + + ! Read number of realizations for global tallies + call read_data(n_realizations, "n_realizations") + + ! Read number of global tallies + call 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", & + n1=N_GLOBAL_TALLIES, n2=1) + + ! Check if tally results are present + call read_data(int_array(1), "tallies_present", group="tallies") + + ! Read in sum and sum squared + if (int_array(1) == 1) then + TALLY_RESULTS: do i = 1, n_tallies + + ! Set pointer to tally + t => tallies(i) + + ! Read sum and sum_sq for each bin + call read_tally_result(t % results, "results", & + group="tallies/tally" // to_str(i), & + n1=size(t % results, 1), n2=size(t % results, 2)) + + end do TALLY_RESULTS + end if + end if + + ! Read source if in eigenvalue mode + if (run_mode == MODE_EIGENVALUE .and. run_mode /= MODE_TALLIES) then + + ! Change file handles if source is separately written +#ifdef HDF5 +# ifdef MPI + source_separate = .true. +# endif +#endif + + if (source_separate) then + + ! Close statepoint file + call file_close(fh_state_point) + + ! Set filename for source + filename = trim(path_output) // 'source.' // & + trim(to_str(restart_batch)) + + ! Write message + message = "Loading source file " // trim(filename) // "..." + call write_message(1) + + ! Create statepoint file + call file_open(filename, fh_source) + + end if + + ! Write out source + call read_source_bank() + + ! Close file + if (source_separate) then + call file_close(fh_source) + else + call file_close(fh_state_point) + end if + + else + + ! Close file if not in eigenvalue mode + call file_close(fh_state_point) + + end if + end subroutine load_state_point !=============================================================================== -! WRITE_SOURCE +! REPLAY_BATCH_HISTORY displays batch keff and entropy for each batch stored in +! a state point file !=============================================================================== - subroutine write_source() + subroutine replay_batch_history - end subroutine write_source + integer :: n = 0 ! number of realizations + real(8), save :: temp(2) = ZERO ! temporary values for keff + real(8) :: alpha ! significance level for CI + real(8) :: t_value ! t-value for confidence intervals -!=============================================================================== -! READ_SOURCE -!=============================================================================== + ! Write message at beginning + if (current_batch == 1) then + message = "Replaying history from state point..." + call write_message(1) + end if - subroutine read_source() + ! Add to number of realizations + if (current_batch > n_inactive) then + n = n + 1 - end subroutine read_source + temp(1) = temp(1) + k_batch(current_batch) + temp(2) = temp(2) + k_batch(current_batch)*k_batch(current_batch) -!=============================================================================== -! REPLAY_BATCH_HISTORY -!=============================================================================== + ! calculate mean keff + keff = temp(1) / n - subroutine replay_batch_history() + if (n > 1) then + if (confidence_intervals) then + ! Calculate t-value for confidence intervals + alpha = ONE - CONFIDENCE_LEVEL + t_value = t_percentile(ONE - alpha/TWO, n - 1) + else + t_value = ONE + end if + + keff_std = t_value * sqrt((temp(2)/n - keff*keff)/(n - 1)) + end if + else + keff = k_batch(current_batch) + end if + + ! print out batch keff + if (master) call print_batch_keff() + + ! Write message at end + if (current_batch == restart_batch) then + message = "Resuming simulation..." + call write_message(1) + end if end subroutine replay_batch_history + subroutine read_source +! TODO write this routine +! TODO what if n_particles does not match source bank + end subroutine read_source end module state_point From f74842745a7541a5fa083f696e9559f441050a5a Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Mon, 13 May 2013 07:10:42 -0700 Subject: [PATCH 14/65] moved hdf5 initialize and finalize routines out of interface and into initialize and finalize modules --- src/finalize.F90 | 12 ++++----- src/global.F90 | 2 -- src/hdf5_interface.F90 | 56 ------------------------------------------ src/initialize.F90 | 51 +++++++++++++++++++++++++++++++++++--- 4 files changed, 54 insertions(+), 67 deletions(-) diff --git a/src/finalize.F90 b/src/finalize.F90 index d601c2e592..66f657a9d2 100644 --- a/src/finalize.F90 +++ b/src/finalize.F90 @@ -11,10 +11,6 @@ module finalize use mpi #endif -#ifdef HDF5 - use hdf5_interface, only: hdf5_finalize -#endif - implicit none contains @@ -56,8 +52,12 @@ contains call free_memory() #ifdef HDF5 - ! Close HDF5 interface and release memory - call hdf5_finalize() + ! Release compound datatypes + call h5tclose_f(hdf5_tallyresult_t, hdf5_err) + call h5tclose_f(hdf5_bank_t, hdf5_err) + + ! Close FORTRAN interface. + call h5close_f(hdf5_err) #endif #ifdef MPI diff --git a/src/global.F90 b/src/global.F90 index 497fe6a966..af20c135af 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -241,8 +241,6 @@ module global integer(HID_T) :: hdf5_tallyresult_t ! Compound type for TallyResult integer(HID_T) :: hdf5_bank_t ! Compound type for Bank integer(HID_T) :: hdf5_integer8_t ! type for integer(8) - integer(HID_T) :: hdf5_state_point ! file id - integer(HID_T) :: hdf5_plist ! parallel property list integer :: hdf5_err ! error flag #endif diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 7ff2d67b8a..0bf485efc0 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -24,62 +24,6 @@ module hdf5_interface contains -!=============================================================================== -! HDF5_INITIALIZE -!=============================================================================== - - subroutine hdf5_initialize() - - type(TallyResult), target :: tmp(2) ! temporary TallyResult - type(Bank), target :: tmpb(2) ! temporary Bank - integer(HID_T) :: coordinates_t ! HDF5 type for 3 reals - integer(HSIZE_T) :: dims(1) = (/3/) ! size of coordinates - - ! Initialize FORTRAN interface. - call h5open_f(hdf5_err) - - ! Create the compound datatype for TallyResult - call h5tcreate_f(H5T_COMPOUND_F, h5offsetof(c_loc(tmp(1)), & - c_loc(tmp(2))), hdf5_tallyresult_t, hdf5_err) - call h5tinsert_f(hdf5_tallyresult_t, "sum", h5offsetof(c_loc(tmp(1)), & - c_loc(tmp(1)%sum)), H5T_NATIVE_DOUBLE, hdf5_err) - call h5tinsert_f(hdf5_tallyresult_t, "sum_sq", h5offsetof(c_loc(tmp(1)), & - c_loc(tmp(1)%sum_sq)), H5T_NATIVE_DOUBLE, hdf5_err) - - ! Create compound type for xyz and uvw - call h5tarray_create_f(H5T_NATIVE_DOUBLE, 1, dims, coordinates_t, hdf5_err) - - ! Create the compound datatype for Bank - call h5tcreate_f(H5T_COMPOUND_F, h5offsetof(c_loc(tmpb(1)), & - c_loc(tmpb(2))), hdf5_bank_t, hdf5_err) - call h5tinsert_f(hdf5_bank_t, "wgt", h5offsetof(c_loc(tmpb(1)), & - c_loc(tmpb(1)%wgt)), H5T_NATIVE_DOUBLE, hdf5_err) - call h5tinsert_f(hdf5_bank_t, "xyz", h5offsetof(c_loc(tmpb(1)), & - c_loc(tmpb(1)%xyz)), coordinates_t, hdf5_err) - call h5tinsert_f(hdf5_bank_t, "uvw", h5offsetof(c_loc(tmpb(1)), & - c_loc(tmpb(1)%uvw)), coordinates_t, hdf5_err) - call h5tinsert_f(hdf5_bank_t, "E", h5offsetof(c_loc(tmpb(1)), & - c_loc(tmpb(1)%E)), H5T_NATIVE_DOUBLE, hdf5_err) - - ! Determine type for integer(8) - hdf5_integer8_t = h5kind_to_type(8, H5_INTEGER_KIND) - - end subroutine hdf5_initialize - -!=============================================================================== -! HDF5_FINALIZE -!=============================================================================== - - subroutine hdf5_finalize() - - ! Release compound datatypes - call h5tclose_f(hdf5_tallyresult_t, hdf5_err) - - ! Close FORTRAN interface. - call h5close_f(hdf5_err) - - end subroutine hdf5_finalize - !=============================================================================== ! HDF5_WRITE_SUMMARY !=============================================================================== diff --git a/src/initialize.F90 b/src/initialize.F90 index 18dfff601a..5025305d65 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -17,7 +17,7 @@ module initialize use source, only: initialize_source use state_point, only: load_state_point use string, only: to_str, str_to_int, starts_with, ends_with - use tally_header, only: TallyObject + use tally_header, only: TallyObject, TallyResult use tally_initialize, only: configure_tallies #ifdef MPI @@ -25,8 +25,7 @@ module initialize #endif #ifdef HDF5 - use hdf5_interface, only: hdf5_initialize, hdf5_write_summary, & - hdf5_load_state_point + use hdf5_interface #endif implicit none @@ -240,6 +239,52 @@ contains end subroutine initialize_mpi #endif +#ifdef HDF5 + +!=============================================================================== +! HDF5_INITIALIZE +!=============================================================================== + + subroutine hdf5_initialize() + + type(TallyResult), target :: tmp(2) ! temporary TallyResult + type(Bank), target :: tmpb(2) ! temporary Bank + integer(HID_T) :: coordinates_t ! HDF5 type for 3 reals + integer(HSIZE_T) :: dims(1) = (/3/) ! size of coordinates + + ! Initialize FORTRAN interface. + call h5open_f(hdf5_err) + + ! Create the compound datatype for TallyResult + call h5tcreate_f(H5T_COMPOUND_F, h5offsetof(c_loc(tmp(1)), & + c_loc(tmp(2))), hdf5_tallyresult_t, hdf5_err) + call h5tinsert_f(hdf5_tallyresult_t, "sum", h5offsetof(c_loc(tmp(1)), & + c_loc(tmp(1)%sum)), H5T_NATIVE_DOUBLE, hdf5_err) + call h5tinsert_f(hdf5_tallyresult_t, "sum_sq", h5offsetof(c_loc(tmp(1)), & + c_loc(tmp(1)%sum_sq)), H5T_NATIVE_DOUBLE, hdf5_err) + + ! Create compound type for xyz and uvw + call h5tarray_create_f(H5T_NATIVE_DOUBLE, 1, dims, coordinates_t, hdf5_err) + + ! Create the compound datatype for Bank + call h5tcreate_f(H5T_COMPOUND_F, h5offsetof(c_loc(tmpb(1)), & + c_loc(tmpb(2))), hdf5_bank_t, hdf5_err) + call h5tinsert_f(hdf5_bank_t, "wgt", h5offsetof(c_loc(tmpb(1)), & + c_loc(tmpb(1)%wgt)), H5T_NATIVE_DOUBLE, hdf5_err) + call h5tinsert_f(hdf5_bank_t, "xyz", h5offsetof(c_loc(tmpb(1)), & + c_loc(tmpb(1)%xyz)), coordinates_t, hdf5_err) + call h5tinsert_f(hdf5_bank_t, "uvw", h5offsetof(c_loc(tmpb(1)), & + c_loc(tmpb(1)%uvw)), coordinates_t, hdf5_err) + call h5tinsert_f(hdf5_bank_t, "E", h5offsetof(c_loc(tmpb(1)), & + c_loc(tmpb(1)%E)), H5T_NATIVE_DOUBLE, hdf5_err) + + ! Determine type for integer(8) + hdf5_integer8_t = h5kind_to_type(8, H5_INTEGER_KIND) + + end subroutine hdf5_initialize + +#endif + !=============================================================================== ! READ_COMMAND_LINE reads all parameters from the command line !=============================================================================== From a8786601c1ba4bf87a452ca5fd13663d20d0afce Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Mon, 13 May 2013 08:56:27 -0700 Subject: [PATCH 15/65] removed all code from hdf5 interface except for interface procedures, move hdf5 summary to separate module and restructed dependencies --- src/DEPENDENCIES | 20 +- src/OBJECTS | 1 + src/eigenvalue.F90 | 9 +- src/finalize.F90 | 4 + src/fixed_source.F90 | 8 - src/global.F90 | 1 - src/hdf5_interface.F90 | 1211 +------------------------------------- src/hdf5_summary.F90 | 753 ++++++++++++++++++++++++ src/initialize.F90 | 1 + src/output_interface.F90 | 4 +- src/particle_restart.F90 | 4 +- 11 files changed, 789 insertions(+), 1227 deletions(-) create mode 100644 src/hdf5_summary.F90 diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index e9f72f72b3..1ef2e5cdb0 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -173,17 +173,19 @@ global.o: source_header.o global.o: tally_header.o global.o: timer_header.o -hdf5_interface.o: ace_header.o -hdf5_interface.o: bank_header.o hdf5_interface.o: constants.o -hdf5_interface.o: endf.o -hdf5_interface.o: error.o -hdf5_interface.o: geometry_header.o -hdf5_interface.o: global.o -hdf5_interface.o: material_header.o -hdf5_interface.o: output.o hdf5_interface.o: string.o -hdf5_interface.o: tally_header.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: output.o +hdf5_summary.o: string.o +hdf5_summary.o: tally_header.o initialize.o: ace.o initialize.o: bank_header.o diff --git a/src/OBJECTS b/src/OBJECTS index 763e6a50f8..f40b1250cb 100644 --- a/src/OBJECTS +++ b/src/OBJECTS @@ -29,6 +29,7 @@ geometry.o \ geometry_header.o \ global.o \ hdf5_interface.o \ +hdf5_summary.o \ initialize.o \ interpolation.o \ input_xml.o \ diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index 6749a65acd..963b583ef8 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -22,10 +22,6 @@ module eigenvalue use tally, only: synchronize_tallies, setup_active_usertallies, & reset_result -#ifdef HDF5 - use hdf5_interface, only: hdf5_write_state_point -#endif - private public :: run_eigenvalue @@ -183,11 +179,8 @@ contains if (master) call calculate_combined_keff() ! Create state point file -!#ifdef HDF5 -! call hdf5_write_state_point() -!#else call write_state_point() -!#endif + end if if (master .and. current_batch == n_batches) then diff --git a/src/finalize.F90 b/src/finalize.F90 index 66f657a9d2..2e51362b94 100644 --- a/src/finalize.F90 +++ b/src/finalize.F90 @@ -11,6 +11,10 @@ module finalize use mpi #endif +#ifdef HDF5 + use hdf5_interface, only: hdf5_err +#endif + implicit none contains diff --git a/src/fixed_source.F90 b/src/fixed_source.F90 index 1d2b3bf00d..73c5291eb5 100644 --- a/src/fixed_source.F90 +++ b/src/fixed_source.F90 @@ -11,10 +11,6 @@ module fixed_source use string, only: to_str use tally, only: synchronize_tallies, setup_active_usertallies -#ifdef HDF5 - use hdf5_interface, only: hdf5_write_state_point -#endif - type(Bank), pointer :: source_site => null() contains @@ -115,11 +111,7 @@ contains ! Write out state point if it's been specified for this batch if (statepoint_batch % contains(current_batch)) then -#ifdef HDF5 - call hdf5_write_state_point() -#else call write_state_point() -#endif end if end subroutine finalize_batch diff --git a/src/global.F90 b/src/global.F90 index af20c135af..b59d6dc111 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -241,7 +241,6 @@ module global integer(HID_T) :: hdf5_tallyresult_t ! Compound type for TallyResult integer(HID_T) :: hdf5_bank_t ! Compound type for Bank integer(HID_T) :: hdf5_integer8_t ! type for integer(8) - integer :: hdf5_err ! error flag #endif ! ============================================================================ diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 0bf485efc0..3470aadf85 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -1,1209 +1,24 @@ module hdf5_interface - use ace_header, only: Reaction, UrrData - use bank_header, only: Bank - use constants - use endf, only: reaction_name - use error, only: fatal_error - use geometry_header, only: Cell, Surface, Universe, Lattice - use global - use material_header, only: Material - use output, only: write_message, time_stamp - use string, only: to_str - use tally_header, only: TallyObject - #ifdef HDF5 + + use constants use hdf5 use h5lt use, intrinsic :: ISO_C_BINDING +#ifdef MPI + use mpi +#endif + implicit none integer(HID_T) :: hdf5_fh integer(HID_T) :: temp_group + integer :: hdf5_err contains -!=============================================================================== -! HDF5_WRITE_SUMMARY -!=============================================================================== - - subroutine hdf5_write_summary() - - character(MAX_FILE_LEN) :: filename = "summary.h5" - - ! Create a new file using default properties. - call h5fcreate_f(filename, H5F_ACC_TRUNC_F, hdf5_output_file, hdf5_err) - - ! Write header information - call hdf5_write_header() - - ! Write eigenvalue information - if (run_mode == MODE_EIGENVALUE) then - ! Need to write integer(8)'s using double instead since there is no H5LT - ! call for making a dataset of type long - call hdf5_write_double(hdf5_output_file, "n_particles", real(n_particles,8)) - - ! Use H5LT interface to write n_batches, n_inactive, and n_active - call hdf5_write_integer(hdf5_output_file, "n_batches", n_batches) - call hdf5_write_integer(hdf5_output_file, "n_inactive", n_inactive) - call hdf5_write_integer(hdf5_output_file, "n_active", n_active) - call hdf5_write_integer(hdf5_output_file, "gen_per_batch", gen_per_batch) - - ! Add description of each variable - call h5ltset_attribute_string_f(hdf5_output_file, "n_particles", & - "description", "Number of particles per generation", hdf5_err) - call h5ltset_attribute_string_f(hdf5_output_file, "n_batches", & - "description", "Total number of batches", hdf5_err) - call h5ltset_attribute_string_f(hdf5_output_file, "n_inactive", & - "description", "Number of inactive batches", hdf5_err) - call h5ltset_attribute_string_f(hdf5_output_file, "n_active", & - "description", "Number of active batches", hdf5_err) - call h5ltset_attribute_string_f(hdf5_output_file, "gen_per_batch", & - "description", "Number of generations per batch", hdf5_err) - end if - - call hdf5_write_geometry() - call hdf5_write_materials() - call hdf5_write_nuclides() - if (n_tallies > 0) then - call hdf5_write_tallies() - end if - - ! Terminate access to the file. - call h5fclose_f(hdf5_output_file, hdf5_err) - - end subroutine hdf5_write_summary - -!=============================================================================== -! HDF5_WRITE_HEADER -!=============================================================================== - - subroutine hdf5_write_header() - - ! Write version information - call hdf5_write_integer(hdf5_output_file, "version_major", VERSION_MAJOR) - call hdf5_write_integer(hdf5_output_file, "version_minor", VERSION_MINOR) - call hdf5_write_integer(hdf5_output_file, "version_release", VERSION_RELEASE) - - ! Write current date and time - call h5ltmake_dataset_string_f(hdf5_output_file, "date_and_time", & - time_stamp(), hdf5_err) - - ! Write MPI information - call hdf5_write_integer(hdf5_output_file, "n_procs", n_procs) - call h5ltset_attribute_string_f(hdf5_output_file, "n_procs", & - "description", "Number of MPI processes", hdf5_err) - - end subroutine hdf5_write_header - -!=============================================================================== -! HDF5_WRITE_GEOMETRY -!=============================================================================== - - subroutine hdf5_write_geometry() - - integer :: i, j, k, m - integer :: n_x, n_y, n_z - integer(HSIZE_T) :: dims(1) - integer(HSIZE_T) :: dims3(3) - integer(HID_T) :: geometry_group - integer(HID_T) :: cell_group - integer(HID_T) :: surface_group - integer(HID_T) :: universe_group - integer(HID_T) :: lattice_group - integer(HID_T) :: temp_group - integer, allocatable :: lattice_universes(:,:,:) - type(Cell), pointer :: c => null() - type(Surface), pointer :: s => null() - type(Universe), pointer :: u => null() - type(Lattice), pointer :: lat => null() - - ! Create group for geometry - call h5gcreate_f(hdf5_output_file, "/geometry", geometry_group, hdf5_err) - - ! Use H5LT interface to write number of geometry objects - call hdf5_write_integer(geometry_group, "n_cells", n_cells) - call hdf5_write_integer(geometry_group, "n_surfaces", n_surfaces) - call hdf5_write_integer(geometry_group, "n_universes", n_universes) - call hdf5_write_integer(geometry_group, "n_lattices", n_lattices) - - ! ========================================================================== - ! WRITE INFORMATION ON CELLS - - call h5gcreate_f(geometry_group, "cells", cell_group, hdf5_err) - - ! Write information on each cell - do i = 1, n_cells - c => cells(i) - - ! Create group for i-th cell - call h5gcreate_f(cell_group, "cell " // trim(to_str(c % id)), & - temp_group, hdf5_err) - - ! Write universe for this cell - call hdf5_write_integer(temp_group, "universe", & - universes(c % universe) % id) - - ! Write information on what fills this cell - select case (c % type) - case (CELL_NORMAL) - call h5ltmake_dataset_string_f(temp_group, "fill_type", "normal", & - hdf5_err) - if (c % material == MATERIAL_VOID) then - call hdf5_write_integer(temp_group, "material", -1) - else - call hdf5_write_integer(temp_group, "material", & - materials(c % material) % id) - end if - case (CELL_FILL) - call h5ltmake_dataset_string_f(temp_group, "fill_type", "universe", & - hdf5_err) - call hdf5_write_integer(temp_group, "material", & - universes(c % fill) % id) - case (CELL_LATTICE) - call h5ltmake_dataset_string_f(temp_group, "fill_type", "lattice", & - hdf5_err) - call hdf5_write_integer(temp_group, "lattice", & - lattices(c % fill) % id) - end select - - ! Write list of bounding surfaces - if (c % n_surfaces > 0) then - dims(1) = c % n_surfaces - call h5ltmake_dataset_int_f(temp_group, "surfaces", 1, & - dims, c % surfaces, hdf5_err) - end if - - ! Close group for i-th cell - call h5gclose_f(temp_group, hdf5_err) - end do - - call h5gclose_f(cell_group, hdf5_err) - - ! ========================================================================== - ! WRITE INFORMATION ON SURFACES - - call h5gcreate_f(geometry_group, "surfaces", surface_group, hdf5_err) - - ! Write information on each surface - do i = 1, n_surfaces - s => surfaces(i) - - ! Create group for i-th surface - call h5gcreate_f(surface_group, "surface " // trim(to_str(s % id)), & - temp_group, hdf5_err) - - ! Write surface type - select case (s % type) - case (SURF_PX) - call h5ltmake_dataset_string_f(temp_group, "type", "X Plane", hdf5_err) - case (SURF_PY) - call h5ltmake_dataset_string_f(temp_group, "type", "Y Plane", hdf5_err) - case (SURF_PZ) - call h5ltmake_dataset_string_f(temp_group, "type", "Z Plane", hdf5_err) - case (SURF_PLANE) - call h5ltmake_dataset_string_f(temp_group, "type", "Plane", hdf5_err) - case (SURF_CYL_X) - call h5ltmake_dataset_string_f(temp_group, "type", "X Cylinder", hdf5_err) - case (SURF_CYL_Y) - call h5ltmake_dataset_string_f(temp_group, "type", "Y Cylinder", hdf5_err) - case (SURF_CYL_Z) - call h5ltmake_dataset_string_f(temp_group, "type", "Z Cylinder", hdf5_err) - case (SURF_SPHERE) - call h5ltmake_dataset_string_f(temp_group, "type", "Sphere", hdf5_err) - case (SURF_CONE_X) - call h5ltmake_dataset_string_f(temp_group, "type", "X Cone", hdf5_err) - case (SURF_CONE_Y) - call h5ltmake_dataset_string_f(temp_group, "type", "Y Cone", hdf5_err) - case (SURF_CONE_Z) - call h5ltmake_dataset_string_f(temp_group, "type", "Z Cone", hdf5_err) - end select - - ! Write coefficients for surface - dims(1) = size(s % coeffs) - call h5ltmake_dataset_double_f(temp_group, "coefficients", 1, dims, & - s % coeffs, hdf5_err) - - ! Write positive neighbors - if (allocated(s % neighbor_pos)) then - dims(1) = size(s % neighbor_pos) - call h5ltmake_dataset_int_f(temp_group, "neighbors_positive", 1, dims, & - s % neighbor_pos, hdf5_err) - end if - - ! Write negative neighbors - if (allocated(s % neighbor_neg)) then - dims(1) = size(s % neighbor_neg) - call h5ltmake_dataset_int_f(temp_group, "neighbors_negative", 1, dims, & - s % neighbor_neg, hdf5_err) - end if - - ! Write boundary condition - select case (s % bc) - case (BC_TRANSMIT) - call h5ltmake_dataset_string_f(temp_group, "boundary_condition", & - "transmission", hdf5_err) - case (BC_VACUUM) - call h5ltmake_dataset_string_f(temp_group, "boundary_condition", & - "vacuum", hdf5_err) - case (BC_REFLECT) - call h5ltmake_dataset_string_f(temp_group, "boundary_condition", & - "reflective", hdf5_err) - case (BC_PERIODIC) - call h5ltmake_dataset_string_f(temp_group, "boundary_condition", & - "periodic", hdf5_err) - end select - - ! Close group for i-th surface - call h5gclose_f(temp_group, hdf5_err) - end do - - call h5gclose_f(surface_group, hdf5_err) - - ! ========================================================================== - ! WRITE INFORMATION ON UNIVERSES - - call h5gcreate_f(geometry_group, "universes", universe_group, hdf5_err) - - ! Write information on each universe - do i = 1, n_universes - u => universes(i) - - ! Create group for i-th universe - call h5gcreate_f(universe_group, "universe " // trim(to_str(u % id)), & - temp_group, hdf5_err) - - ! Write list of cells in this universe - if (u % n_cells > 0) then - dims(1) = u % n_cells - call h5ltmake_dataset_int_f(temp_group, "cells", 1, dims, & - u % cells, hdf5_err) - end if - - ! Close group for i-th universe - call h5gclose_f(temp_group, hdf5_err) - end do - - call h5gclose_f(universe_group, hdf5_err) - - ! ========================================================================== - ! WRITE INFORMATION ON LATTICES - - call h5gcreate_f(geometry_group, "lattices", lattice_group, hdf5_err) - - ! Write information on each lattice - do i = 1, n_lattices - lat => lattices(i) - - ! Create group for i-th lattice - call h5gcreate_f(lattice_group, "lattice " // trim(to_str(lat % id)), & - temp_group, hdf5_err) - - ! Write lattice type - select case(lat % type) - case (LATTICE_RECT) - call h5ltmake_dataset_string_f(temp_group, "type", "rectangular", hdf5_err) - case (LATTICE_HEX) - call h5ltmake_dataset_string_f(temp_group, "type", "hexagonal", hdf5_err) - end select - - ! Write lattice dimensions, lower left corner, and width of element - dims(1) = lat % n_dimension - call h5ltmake_dataset_int_f(temp_group, "dimension", 1, dims, & - lat % dimension, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "lower_left", 1, dims, & - lat % lower_left, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "width", 1, dims, & - lat % width, hdf5_err) - - ! Determine dimensions of lattice - n_x = lat % dimension(1) - n_y = lat % dimension(2) - if (lat % n_dimension == 3) then - n_z = lat % dimension(3) - else - n_z = 1 - end if - - ! Write lattice universes - allocate(lattice_universes(n_x, n_y, n_z)) - do j = 1, n_x - do k = 1, n_y - do m = 1, n_z - lattice_universes(j,k,m) = universes(lat % universes(j,k,m)) % id - end do - end do - end do - dims3 = (/ n_x, n_y, n_z /) - call h5ltmake_dataset_int_f(temp_group, "universes", 3, dims3, & - lattice_universes, hdf5_err) - deallocate(lattice_universes) - - ! Close group for i-th lattice - call h5gclose_f(temp_group, hdf5_err) - end do - - call h5gclose_f(lattice_group, hdf5_err) - - ! Close geometry group - call h5gclose_f(geometry_group, hdf5_err) - - end subroutine hdf5_write_geometry - -!=============================================================================== -! HDF5_WRITE_MATERIALS -!=============================================================================== - - subroutine hdf5_write_materials() - - integer :: i - integer :: j - integer(HSIZE_T) :: dims(1) - integer(HID_T) :: materials_group - integer(HID_T) :: temp_group - integer, allocatable :: zaids(:) - type(Material), pointer :: m => null() - - ! Create group for materials - call h5gcreate_f(hdf5_output_file, "/materials", materials_group, hdf5_err) - - ! Use H5LT interface to write number of materials - call hdf5_write_integer(materials_group, "n_materials", n_materials) - - ! Write information on each material - do i = 1, n_materials - m => materials(i) - - ! Create group for i-th universe - call h5gcreate_f(materials_group, "material " // trim(to_str(m % id)), & - temp_group, hdf5_err) - - ! Write atom density with units - call hdf5_write_double(temp_group, "atom_density", m % density) - call h5ltset_attribute_string_f(temp_group, "atom_density", & - "units", "atom/barn-cm", hdf5_err) - - ! Copy ZAID for each nuclide to temporary array - allocate(zaids(m % n_nuclides)) - do j = 1, m % n_nuclides - zaids(j) = nuclides(m % nuclide(j)) % zaid - end do - - ! Write temporary array to 'nuclides' - dims(1) = m % n_nuclides - call h5ltmake_dataset_int_f(temp_group, "nuclides", 1, & - dims, zaids, hdf5_err) - - ! Deallocate temporary array - deallocate(zaids) - - ! Write atom densities - call h5ltmake_dataset_double_f(temp_group, "nuclide_densities", 1, & - dims, m % atom_density, hdf5_err) - - ! Write S(a,b) information if present - if (m % n_sab > 0) then - dims(1) = m % n_sab - call h5ltmake_dataset_int_f(temp_group, "i_sab_nuclides", 1, & - dims, m % i_sab_nuclides, hdf5_err) - call h5ltmake_dataset_int_f(temp_group, "i_sab_tables", 1, & - dims, m % i_sab_tables, hdf5_err) - end if - - ! Close group for i-th material - call h5gclose_f(temp_group, hdf5_err) - end do - - ! Close materials group - call h5gclose_f(materials_group, hdf5_err) - - end subroutine hdf5_write_materials - -!=============================================================================== -! HDF5_WRITE_TALLIES -!=============================================================================== - - subroutine hdf5_write_tallies() - - integer :: i, j - integer(HSIZE_T) :: dims(1) - integer(HID_T) :: tallies_group - integer(HID_T) :: temp_group - integer(HID_T) :: filter_group ! group for i-th filter - integer, allocatable :: temp_array(:) ! nuclide bin array - type(TallyObject), pointer :: t => null() - - ! Create group for tallies - call h5gcreate_f(hdf5_output_file, "tallies", tallies_group, hdf5_err) - - ! Write total number of meshes - call hdf5_write_integer(tallies_group, "n_meshes", n_meshes) - - ! Write information for meshes - MESH_LOOP: do i = 1, n_meshes - ! Create temporary group for each mesh - call h5gcreate_f(tallies_group, "mesh" // to_str(i), & - temp_group, hdf5_err) - - ! Write type and number of dimensions - call hdf5_write_integer(temp_group, "type", meshes(i) % type) - call hdf5_write_integer(temp_group, "n_dimension", & - meshes(i) % n_dimension) - - ! Write mesh information - dims(1) = meshes(i) % n_dimension - call h5ltmake_dataset_int_f(temp_group, "dimension", 1, & - dims, meshes(i) % dimension, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "lower_left", 1, & - dims, meshes(i) % lower_left, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "upper_right", 1, & - dims, meshes(i) % upper_right, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "width", 1, & - dims, meshes(i) % width, hdf5_err) - - ! Close temporary group for mesh - call h5gclose_f(temp_group, hdf5_err) - end do MESH_LOOP - - ! Write number of tallies - call hdf5_write_integer(tallies_group, "n_tallies", n_tallies) - - TALLY_METADATA: do i = 1, n_tallies - ! Get pointer to tally - t => tallies(i) - - ! Create group for this tally - call h5gcreate_f(tallies_group, "tally" // to_str(i), & - temp_group, hdf5_err) - - ! Write size of each tally - call hdf5_write_integer(temp_group, "total_score_bins", & - t % total_score_bins) - call hdf5_write_integer(temp_group, "total_filter_bins", & - t % total_filter_bins) - - ! Write number of filters - call hdf5_write_integer(temp_group, "n_filters", t % n_filters) - - FILTER_LOOP: do j = 1, t % n_filters - ! Create filter group - call h5gcreate_f(temp_group, "filter" // to_str(j), filter_group, & - hdf5_err) - - ! Write type of filter - call hdf5_write_integer(filter_group, "type", t % filters(j) % type) - - ! Write number of bins for this filter - call hdf5_write_integer(filter_group, "n_bins", t % filters(j) % n_bins) - - ! Write filter bins - if (t % filters(j) % type == FILTER_ENERGYIN .or. & - t % filters(j) % type == FILTER_ENERGYOUT) then - dims(1) = size(t % filters(j) % real_bins) - call h5ltmake_dataset_double_f(filter_group, "bins", 1, & - dims, t % filters(j) % real_bins, hdf5_err) - else - dims(1) = size(t % filters(j) % int_bins) - call h5ltmake_dataset_int_f(filter_group, "bins", 1, & - dims, t % filters(j) % int_bins, hdf5_err) - end if - - ! Write name of type - select case (t % filters(j) % type) - case(FILTER_UNIVERSE) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "universe", hdf5_err) - case(FILTER_MATERIAL) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "material", hdf5_err) - case(FILTER_CELL) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "cell", hdf5_err) - case(FILTER_CELLBORN) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "cellborn", hdf5_err) - case(FILTER_SURFACE) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "surface", hdf5_err) - case(FILTER_MESH) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "mesh", hdf5_err) - case(FILTER_ENERGYIN) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "energy", hdf5_err) - case(FILTER_ENERGYOUT) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "energyout", hdf5_err) - end select - - ! Close group for this filter - call h5gclose_f(filter_group, hdf5_err) - end do FILTER_LOOP - - ! Write number of nuclide bins - call hdf5_write_integer(temp_group, "n_nuclide_bins", & - t % n_nuclide_bins) - - - ! Create temporary array for nuclide bins - allocate(temp_array(t % n_nuclide_bins)) - NUCLIDE_LOOP: do j = 1, t % n_nuclide_bins - if (t % nuclide_bins(j) > 0) then - temp_array(j) = nuclides(t % nuclide_bins(j)) % zaid - else - temp_array(j) = t % nuclide_bins(j) - end if - end do NUCLIDE_LOOP - - ! Write and deallocate nuclide bins - dims(1) = t % n_nuclide_bins - call h5ltmake_dataset_int_f(temp_group, "nuclide_bins", 1, & - dims, temp_array, hdf5_err) - deallocate(temp_array) - - ! Write number of score bins - call hdf5_write_integer(temp_group, "n_score_bins", & - t % n_score_bins) - dims(1) = t % n_score_bins - call h5ltmake_dataset_int_f(temp_group, "score_bins", 1, & - dims, t % score_bins, hdf5_err) - - ! Close tally group - call h5gclose_f(temp_group, hdf5_err) - end do TALLY_METADATA - - ! Close tallies group - call h5gclose_f(tallies_group, hdf5_err) - - end subroutine hdf5_write_tallies - -!=============================================================================== -! HDF5_WRITE_NUCLIDES -!=============================================================================== - - subroutine hdf5_write_nuclides() - - integer :: i, j - integer :: size_total - integer :: size_xs - integer :: size_angle - integer :: size_energy - integer(HID_T) :: group - integer(HID_T) :: nuclide_group - integer(HID_T) :: reactions_group - integer(HID_T) :: rxn_group - type(Nuclide), pointer :: nuc => null() - type(Reaction), pointer :: rxn => null() - type(UrrData), pointer :: urr => null() - - ! Create group for nuclides - call h5gcreate_f(hdf5_output_file, "/nuclides", group, hdf5_err) - - ! Use H5LT interface to write number of nuclides - call hdf5_write_integer(group, "n_nuclides", n_nuclides_total) - - ! Write information on each nuclide - do i = 1, n_nuclides_total - nuc => nuclides(i) - - ! Determine size of cross-sections - size_xs = (5 + nuc % n_reaction) * nuc % n_grid * 8 - size_total = size_xs - - ! Create group for i-th nuclide - call h5gcreate_f(group, trim(nuc % name), nuclide_group, hdf5_err) - - ! Write some basic attributes - call hdf5_write_integer(nuclide_group, "zaid", nuc % zaid) - call hdf5_write_double(nuclide_group, "awr", nuc % awr) - call hdf5_write_double(nuclide_group, "kT", nuc % kT) - call hdf5_write_integer(nuclide_group, "n_grid", nuc % n_grid) - call hdf5_write_integer(nuclide_group, "n_reactions", nuc % n_reaction) - call hdf5_write_integer(nuclide_group, "n_fission", nuc % n_fission) - call hdf5_write_integer(nuclide_group, "size_xs", size_xs) - - ! ======================================================================= - ! WRITE INFORMATION ON EACH REACTION - - ! Create overall group - call h5gcreate_f(nuclide_group, "reactions", reactions_group, hdf5_err) - - do j = 1, nuc % n_reaction - ! Information on each reaction - rxn => nuc % reactions(j) - - ! Determine size of angle distribution - if (rxn % has_angle_dist) then - size_angle = rxn % adist % n_energy * 16 + size(rxn % adist % data) * 8 - else - size_angle = 0 - end if - - ! Determine size of energy distribution - if (rxn % has_energy_dist) then - size_energy = size(rxn % edist % data) * 8 - else - size_energy = 0 - end if - - ! Create reaction group - call h5gcreate_f(reactions_group, reaction_name(rxn % MT), & - rxn_group, hdf5_err) - - ! Write information on reaction - call hdf5_write_double(rxn_group, "Q_value", rxn % Q_value) - call hdf5_write_integer(rxn_group, "multiplicity", rxn % multiplicity) - call hdf5_write_integer(rxn_group, "threshold", rxn % threshold) - call hdf5_write_integer(rxn_group, "size_angle", size_angle) - call hdf5_write_integer(rxn_group, "size_energy", size_energy) - - call h5gclose_f(rxn_group, hdf5_err) - - ! Accumulate data size - size_total = size_total + size_angle + size_energy - end do - - ! Close overall group for reactions - call h5gclose_f(reactions_group, hdf5_err) - - ! ======================================================================= - ! WRITE INFORMATION ON URR PROBABILITY TABLES - - if (nuc % urr_present) then - urr => nuc % urr_data - call hdf5_write_integer(nuclide_group, "urr_n_energy", urr % n_energy) - call hdf5_write_integer(nuclide_group, "urr_n_prob", urr % n_prob) - call hdf5_write_integer(nuclide_group, "urr_interp", urr % interp) - call hdf5_write_integer(nuclide_group, "urr_inelastic", urr % inelastic_flag) - call hdf5_write_integer(nuclide_group, "urr_absorption", urr % absorption_flag) - call hdf5_write_double(nuclide_group, "urr_min_E", urr % energy(1)) - call hdf5_write_double(nuclide_group, "urr_max_E", urr % energy(urr % n_energy)) - end if - - ! Write total memory used - call hdf5_write_integer(nuclide_group, "size_total", size_total) - - ! Close group for i-th nuclide - call h5gclose_f(nuclide_group, hdf5_err) - end do - - ! Close group for nuclides - call h5gclose_f(group, hdf5_err) - - end subroutine hdf5_write_nuclides - -!=============================================================================== -! HDF5_WRITE_TIMING -!=============================================================================== - - subroutine hdf5_write_timing() - - integer(HID_T) :: timing_group - integer(8) :: total_particles - real(8) :: speed - - ! Create group for timing - call h5gcreate_f(hdf5_output_file, "/timing", timing_group, hdf5_err) - - ! Write timing data - call hdf5_write_double(timing_group, "time_initialize", time_initialize % elapsed) - call hdf5_write_double(timing_group, "time_read_xs", time_read_xs % elapsed) - call hdf5_write_double(timing_group, "time_unionize", time_unionize % elapsed) - call hdf5_write_double(timing_group, "time_transport", time_transport % elapsed) - call hdf5_write_double(timing_group, "time_bank", time_bank % elapsed) - call hdf5_write_double(timing_group, "time_bank_sample", time_bank_sample % elapsed) - call hdf5_write_double(timing_group, "time_bank_sendrecv", time_bank_sendrecv % elapsed) - call hdf5_write_double(timing_group, "time_tallies", time_tallies % elapsed) - call hdf5_write_double(timing_group, "time_inactive", time_inactive % elapsed) - call hdf5_write_double(timing_group, "time_active", time_active % elapsed) - call hdf5_write_double(timing_group, "time_finalize", time_finalize % elapsed) - call hdf5_write_double(timing_group, "time_total", time_total % elapsed) - - ! Add descriptions to timing data - call h5ltset_attribute_string_f(timing_group, "time_initialize", & - "description", "Total time elapsed for initialization (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_read_xs", & - "description", "Time reading cross-section libraries (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_unionize", & - "description", "Time unionizing energy grid (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_transport", & - "description", "Time in transport only (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_bank", & - "description", "Total time synchronizing fission bank (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_bank_sample", & - "description", "Time between generations sampling source sites (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_bank_sendrecv", & - "description", "Time between generations SEND/RECVing source sites (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_tallies", & - "description", "Time between batches accumulating tallies (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_inactive", & - "description", "Total time in inactive batches (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_active", & - "description", "Total time in active batches (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_finalize", & - "description", "Total time for finalization (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_total", & - "description", "Total time elapsed (s)", hdf5_err) - - ! Write calculation rate - total_particles = n_particles * n_batches * gen_per_batch - speed = real(total_particles) / (time_inactive % elapsed + & - time_active % elapsed) - call hdf5_write_double(timing_group, "neutrons_per_second", speed) - - ! Close timing group - call h5gclose_f(timing_group, hdf5_err) - - end subroutine hdf5_write_timing - -!=============================================================================== -! HDF5_WRITE_STATE_POINT -!=============================================================================== - - subroutine hdf5_write_state_point() - - integer :: i, j ! loop indices - integer(HSIZE_T) :: dims(1) ! dimensions of 1D arrays - integer(HSIZE_T) :: dims2(2) ! dimensions of 2D arrays - integer(HSIZE_T) :: dims4(4) ! dimensions of 4D arrays - integer(HID_T) :: hdf5_state_point ! identifier for state point file - integer(HID_T) :: tallies_group ! "tallies" group - integer(HID_T) :: temp_group ! group for i-th tally or mesh - integer(HID_T) :: filter_group ! group for i-th filter - integer(HID_T) :: cmfd_group ! group for cmfd output - integer(HID_T) :: dspace ! identifier for dataspace - integer(HID_T) :: dset ! identifier for dataset - integer, allocatable :: temp_array(:) ! nuclide bin array - character(MAX_FILE_LEN) :: filename ! Path to state point - type(c_ptr) :: f_ptr ! Pointer for h5dwrite - type(TallyObject), pointer :: t => null() - - filename = trim(path_output) // 'statepoint.' // & - trim(to_str(current_batch)) // '.h5' - - ! Write message - message = "Creating HDF5 state point " // trim(filename) // "..." - call write_message(1) - - ! Only master process should continue from here - if (.not. master) return - - ! Create a new state point file using default properties. - call h5fcreate_f(filename, H5F_ACC_TRUNC_F, hdf5_state_point, & - hdf5_err) - - ! Write revision number for state point file - call hdf5_write_integer(hdf5_state_point, "revision_statepoint", & - REVISION_STATEPOINT) - - ! Write OpenMC version - call hdf5_write_integer(hdf5_state_point, "version_major", VERSION_MAJOR) - call hdf5_write_integer(hdf5_state_point, "version_minor", VERSION_MINOR) - call hdf5_write_integer(hdf5_state_point, "version_release", VERSION_RELEASE) - - ! Write current date and time - call h5ltmake_dataset_string_f(hdf5_state_point, "date_and_time", & - time_stamp(), hdf5_err) - - ! Write path to input - call h5ltmake_dataset_string_f(hdf5_state_point, "path", & - path_input, hdf5_err) - - ! Write out random number seed - call hdf5_write_long(hdf5_state_point, "seed", seed) - - ! Write run information - call hdf5_write_integer(hdf5_state_point, "run_mode", run_mode) - call hdf5_write_long(hdf5_state_point, "n_particles", n_particles) - call hdf5_write_integer(hdf5_state_point, "n_batches", n_batches) - - ! Write out current batch number - call hdf5_write_integer(hdf5_state_point, "current_batch", current_batch) - - ! Write out information for eigenvalue run - if (run_mode == MODE_EIGENVALUE) then - call hdf5_write_integer(hdf5_state_point, "n_inactive", n_inactive) - call hdf5_write_integer(hdf5_state_point, "gen_per_batch", gen_per_batch) - - ! Write out keff and entropy - dims(1) = current_batch - call h5ltmake_dataset_double_f(hdf5_state_point, "k_batch", 1, & - dims, k_batch, hdf5_err) - dims(1) = current_batch*gen_per_batch - call h5ltmake_dataset_double_f(hdf5_state_point, "entropy", 1, & - dims, entropy, hdf5_err) - call hdf5_write_double(hdf5_state_point, "k_col_abs", k_col_abs) - call hdf5_write_double(hdf5_state_point, "k_col_tra", k_col_tra) - call hdf5_write_double(hdf5_state_point, "k_abs_tra", k_abs_tra) - dims(1) = 2 - call h5ltmake_dataset_double_f(hdf5_state_point, "k_combined", 1, & - dims, k_combined, hdf5_err) - end if - - ! Create group for tallies - call h5gcreate_f(hdf5_state_point, "tallies", tallies_group, hdf5_err) - - ! Write total number of meshes - call hdf5_write_integer(tallies_group, "n_meshes", n_meshes) - - ! Write information for meshes - MESH_LOOP: do i = 1, n_meshes - ! Create temporary group for each mesh - call h5gcreate_f(tallies_group, "mesh" // to_str(i), & - temp_group, hdf5_err) - - ! Write id, type, and number of dimensions - call hdf5_write_integer(temp_group, "id", meshes(i) % id) - call hdf5_write_integer(temp_group, "type", meshes(i) % type) - call hdf5_write_integer(temp_group, "n_dimension", & - meshes(i) % n_dimension) - - ! Write mesh information - dims(1) = meshes(i) % n_dimension - call h5ltmake_dataset_int_f(temp_group, "dimension", 1, & - dims, meshes(i) % dimension, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "lower_left", 1, & - dims, meshes(i) % lower_left, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "upper_right", 1, & - dims, meshes(i) % upper_right, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "width", 1, & - dims, meshes(i) % width, hdf5_err) - - ! Close temporary group for mesh - call h5gclose_f(temp_group, hdf5_err) - end do MESH_LOOP - - ! Write number of tallies - call hdf5_write_integer(tallies_group, "n_tallies", n_tallies) - - TALLY_METADATA: do i = 1, n_tallies - ! Get pointer to tally - t => tallies(i) - - ! Create group for this tally - call h5gcreate_f(tallies_group, "tally" // to_str(i), & - temp_group, hdf5_err) - - ! Write id - call hdf5_write_integer(temp_group, "id", t % id) - - ! Write number of realizations - call hdf5_write_integer(temp_group, "n_realizations", & - t % n_realizations) - - ! Write size of each tally - call hdf5_write_integer(temp_group, "total_score_bins", & - t % total_score_bins) - call hdf5_write_integer(temp_group, "total_filter_bins", & - t % total_filter_bins) - - ! Write number of filters - call hdf5_write_integer(temp_group, "n_filters", t % n_filters) - - FILTER_LOOP: do j = 1, t % n_filters - ! Create filter group - call h5gcreate_f(temp_group, "filter" // to_str(j), filter_group, & - hdf5_err) - - ! Write type of filter - call hdf5_write_integer(filter_group, "type", t % filters(j) % type) - - ! Write number of bins for this filter - call hdf5_write_integer(filter_group, "n_bins", t % filters(j) % n_bins) - - ! Write filter bins - if (t % filters(j) % type == FILTER_ENERGYIN .or. & - t % filters(j) % type == FILTER_ENERGYOUT) then - dims(1) = size(t % filters(j) % real_bins) - call h5ltmake_dataset_double_f(filter_group, "bins", 1, & - dims, t % filters(j) % real_bins, hdf5_err) - else - dims(1) = size(t % filters(j) % int_bins) - call h5ltmake_dataset_int_f(filter_group, "bins", 1, & - dims, t % filters(j) % int_bins, hdf5_err) - end if - - ! Write name of type - select case (t % filters(j) % type) - case(FILTER_UNIVERSE) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "universe", hdf5_err) - case(FILTER_MATERIAL) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "material", hdf5_err) - case(FILTER_CELL) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "cell", hdf5_err) - case(FILTER_CELLBORN) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "cellborn", hdf5_err) - case(FILTER_SURFACE) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "surface", hdf5_err) - case(FILTER_MESH) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "mesh", hdf5_err) - case(FILTER_ENERGYIN) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "energy", hdf5_err) - case(FILTER_ENERGYOUT) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "energyout", hdf5_err) - end select - - ! Close group for this filter - call h5gclose_f(filter_group, hdf5_err) - end do FILTER_LOOP - - ! Write number of nuclide bins - call hdf5_write_integer(temp_group, "n_nuclide_bins", & - t % n_nuclide_bins) - - - ! Create temporary array for nuclide bins - allocate(temp_array(t % n_nuclide_bins)) - NUCLIDE_LOOP: do j = 1, t % n_nuclide_bins - if (t % nuclide_bins(j) > 0) then - temp_array(j) = nuclides(t % nuclide_bins(j)) % zaid - else - temp_array(j) = t % nuclide_bins(j) - end if - end do NUCLIDE_LOOP - - ! Write and deallocate nuclide bins - dims(1) = t % n_nuclide_bins - call h5ltmake_dataset_int_f(temp_group, "nuclide_bins", 1, & - dims, temp_array, hdf5_err) - deallocate(temp_array) - - ! Write number of score bins - call hdf5_write_integer(temp_group, "n_score_bins", & - t % n_score_bins) - - ! Write score bins and scattering order - dims(1) = t % n_score_bins - call h5ltmake_dataset_int_f(temp_group, "score_bins", 1, & - dims, t % score_bins, hdf5_err) - call h5ltmake_dataset_int_f(temp_group, "scatt_order", 1, & - dims, t % scatt_order, hdf5_err) - - ! Write number of user score bins - call hdf5_write_integer(temp_group, "n_user_score_bins", & - t % n_user_score_bins) - - ! Close tally group - call h5gclose_f(temp_group, hdf5_err) - end do TALLY_METADATA - - ! Write number of realizations for global tallies - call hdf5_write_integer(hdf5_state_point, "n_realizations", n_realizations) - - ! Write out global tallies sum and sum_sq - call hdf5_write_integer(hdf5_state_point, "n_global_tallies", & - N_GLOBAL_TALLIES) - - ! Write global tallies - dims(1) = N_GLOBAL_TALLIES - call h5screate_simple_f(1, dims, dspace, hdf5_err) - call h5dcreate_f(hdf5_state_point, "global_tallies", hdf5_tallyresult_t, & - dspace, dset, hdf5_err) - f_ptr = c_loc(global_tallies(1)) - CALL h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - - if (tallies_on) then - ! Indicate that tallies are on - call hdf5_write_integer(tallies_group, "tallies_present", 1) - - ! Write tally sum and sum_sq - TALLY_RESULTS: do i = 1, n_tallies - ! Get pointer to tally - t => tallies(i) - - ! Open group for the i-th tally - call h5gopen_f(tallies_group, "tally" // to_str(i), & - temp_group, hdf5_err) - - ! Write sum and sum_sq for each bin - dims2 = shape(t % results) - call h5screate_simple_f(2, dims2, dspace, hdf5_err) - call h5dcreate_f(temp_group, "results", hdf5_tallyresult_t, & - dspace, dset, hdf5_err) - f_ptr = c_loc(t % results(1, 1)) - CALL h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - - ! Close group for the i-th tally - call h5gclose_f(temp_group, hdf5_err) - end do TALLY_RESULTS - else - ! Indicate that tallies are off - call hdf5_write_integer(tallies_group, "tallies_present", 0) - end if - - ! Close tallies group - call h5gclose_f(tallies_group, hdf5_err) - - ! TODO: Use parallel HDF5 to write source bank - - ! Write source bank - if (source_write) then - dims(1) = work - call h5screate_simple_f(1, dims, dspace, hdf5_err) - call h5dcreate_f(hdf5_state_point, "source_bank", hdf5_bank_t, & - dspace, dset, hdf5_err) - f_ptr = c_loc(source_bank(1)) - CALL h5dwrite_f(dset, hdf5_bank_t, f_ptr, hdf5_err) - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - end if - - ! Write out CMFD info if active - if (cmfd_on) then - - ! Create CMFD group - call h5gcreate_f(hdf5_state_point, "cmfd", cmfd_group, hdf5_err) - - ! write out openmc source - dims4 = shape(cmfd % openmc_src) - call h5ltmake_dataset_double_f(cmfd_group, "openmc_src", 4, & - dims4, cmfd % openmc_src, hdf5_err) - - ! write out cmfd source - dims4 = shape(cmfd % cmfd_src) - call h5ltmake_dataset_double_f(cmfd_group, "cmfd_src", 4, & - dims4, cmfd % cmfd_src, hdf5_err) - - ! write out keff - call hdf5_write_double(cmfd_group, "cmfd_keff", cmfd % keff) - - ! Close CMFD group - call h5gclose_f(tallies_group, hdf5_err) - - end if - - ! Close HDF5 state point file - call h5fclose_f(hdf5_state_point, hdf5_err) - - end subroutine hdf5_write_state_point - -!=============================================================================== -! HDF5_LOAD_STATE_POINT -!=============================================================================== - - subroutine hdf5_load_state_point() - - integer :: i ! loop index - integer :: mode ! specified run mode - integer :: temp ! statepoint revision for comparison - integer(HID_T) :: hdf5_state_point ! identifier for state point file - integer(HID_T) :: tally_group ! identifier for tally group - integer(HID_T) :: dset ! identifier for dataset - integer(HSIZE_T) :: dims(1) ! dimensions of 1D arrays - type(c_ptr) :: f_ptr ! c pointer for h5dread - - ! Write message - message = "Loading HDF5 state point " // trim(path_state_point) // "..." - call write_message(1) - - ! Load state point file - call h5fopen_f(path_state_point, H5F_ACC_RDONLY_F, & - hdf5_state_point, hdf5_err) - - ! Raad revision number for state point file and make sure it matches with - ! current version - call hdf5_read_integer(hdf5_state_point, "revision_statepoint", temp) - if (temp /= REVISION_STATEPOINT) then - message = "State point binary version does not match current version " & - // "in OpenMC." - call fatal_error() - end if - - ! Read and overwrite random number seed - call hdf5_read_long(hdf5_state_point, "seed", seed) - - ! Read and overwrite run information - call hdf5_read_integer(hdf5_state_point, "run_mode", mode) - call hdf5_read_long(hdf5_state_point, "n_particles", n_particles) - call hdf5_read_integer(hdf5_state_point, "n_batches", n_batches) - - ! Read batch number to restart at - call hdf5_read_integer(hdf5_state_point, "current_batch", restart_batch) - - ! Read information specific to eigenvalue run - if (mode == MODE_EIGENVALUE) then - call hdf5_read_integer(hdf5_state_point, "n_inactive", n_inactive) - call hdf5_read_integer(hdf5_state_point, "gen_per_batch", gen_per_batch) - - dims(1) = restart_batch - call h5ltread_dataset_double_f(hdf5_state_point, "k_batch", & - k_batch(1:restart_batch), dims, hdf5_err) - dims(1) = restart_batch*gen_per_batch - call h5ltread_dataset_double_f(hdf5_state_point, "entropy", & - entropy(1:restart_batch*gen_per_batch), dims, hdf5_err) - call hdf5_read_double(hdf5_state_point, "k_col_abs", k_col_abs) - call hdf5_read_double(hdf5_state_point, "k_col_tra", k_col_tra) - call hdf5_read_double(hdf5_state_point, "k_abs_tra", k_abs_tra) - end if - - ! Read number of realizations for global tallies - call hdf5_read_integer(hdf5_state_point, "n_realizations", n_realizations) - - if (master) then - ! Open global tallies dataset - call h5dopen_f(hdf5_state_point, "global_tallies", dset, hdf5_err) - - ! Read global tallies - f_ptr = c_loc(global_tallies(1)) - call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) - - ! Close global tallies dataset - call h5dclose_f(dset, hdf5_err) - - TALLIES_LOOP: do i = 1, n_tallies - ! Open tally group - call h5gopen_f(hdf5_state_point, "tallies/tally" // & - to_str(i), tally_group, hdf5_err) - - ! Read number of realizations - call hdf5_read_integer(tally_group, "n_realizations", & - tallies(i) % n_realizations) - - ! Open dataset for tally results - call h5dopen_f(tally_group, "results", dset, hdf5_err) - - ! Read sum and sum_sq for each tally bin - f_ptr = c_loc(tallies(i) % results(1,1)) - call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) - - ! Close dataset for tally results - call h5dclose_f(dset, hdf5_err) - - ! Close tally group - call h5gclose_f(tally_group, hdf5_err) - end do TALLIES_LOOP - end if - - ! TODO: Use parallel HDF5 to read source bank in parallel - - ! Open dataset for source bank - call h5dopen_f(hdf5_state_point, "source_bank", dset, hdf5_err) - - ! Read source bank - f_ptr = c_loc(source_bank(1)) - call h5dread_f(dset, hdf5_bank_t, f_ptr, hdf5_err) - - ! Close dataset for source bank - call h5dclose_f(dset, hdf5_err) - - ! Close HDF5 state point file - call h5fclose_f(hdf5_state_point, hdf5_err) - - end subroutine hdf5_load_state_point - !=============================================================================== ! HDF5_FILE_CREATE !=============================================================================== @@ -1371,11 +186,12 @@ contains ! HDF5_WRITE_LONG !=============================================================================== - subroutine hdf5_write_long(group, name, buffer) + subroutine hdf5_write_long(group, name, buffer, long_type) integer(HID_T), intent(in) :: group character(*), intent(in) :: name integer(8), target, intent(in) :: buffer + integer(HID_T), intent(in) :: long_type integer :: rank = 1 integer(HSIZE_T) :: dims(1) = (/1/) @@ -1385,11 +201,11 @@ contains ! Create dataspace and dataset call h5screate_simple_f(rank, dims, dspace, hdf5_err) - call h5dcreate_f(group, name, hdf5_integer8_t, dspace, dset, 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, hdf5_integer8_t, f_ptr, hdf5_err) + call h5dwrite_f(dset, long_type, f_ptr, hdf5_err) ! Close dataspace and dataset for long integer call h5dclose_f(dset, hdf5_err) @@ -1492,11 +308,12 @@ contains ! HDF5_READ_LONG !=============================================================================== - subroutine hdf5_read_long(group, name, buffer) + subroutine hdf5_read_long(group, name, buffer, long_type) integer(HID_T), intent(in) :: group character(*), intent(in) :: name integer(8), target, intent(out) :: buffer + integer(HID_T), intent(in) :: long_type integer(HID_T) :: dset type(c_ptr) :: f_ptr @@ -1508,7 +325,7 @@ contains f_ptr = c_loc(buffer) ! Read data from dataset - call h5dread_f(dset, hdf5_integer8_t, f_ptr, hdf5_err) + call h5dread_f(dset, long_type, f_ptr, hdf5_err) ! Close dataset call h5dclose_f(dset, hdf5_err) diff --git a/src/hdf5_summary.F90 b/src/hdf5_summary.F90 new file mode 100644 index 0000000000..b4623e1a72 --- /dev/null +++ b/src/hdf5_summary.F90 @@ -0,0 +1,753 @@ +module hdf5_summary + +#ifdef HDF5 + + use ace_header, only: Reaction, UrrData, Nuclide + use constants + use endf, only: reaction_name + use geometry_header, only: Cell, Surface, Universe, Lattice + use global + use hdf5_interface + use material_header, only: Material + use output, only: time_stamp + use string, only: to_str + use tally_header, only: TallyObject + +contains + +!=============================================================================== +! HDF5_WRITE_SUMMARY +!=============================================================================== + + subroutine hdf5_write_summary() + + character(MAX_FILE_LEN) :: filename = "summary.h5" + + ! Create a new file using default properties. + call h5fcreate_f(filename, H5F_ACC_TRUNC_F, hdf5_output_file, hdf5_err) + + ! Write header information + call hdf5_write_header() + + ! Write eigenvalue information + if (run_mode == MODE_EIGENVALUE) then + ! Need to write integer(8)'s using double instead since there is no H5LT + ! call for making a dataset of type long + call hdf5_write_double(hdf5_output_file, "n_particles", real(n_particles,8)) + + ! Use H5LT interface to write n_batches, n_inactive, and n_active + call hdf5_write_integer(hdf5_output_file, "n_batches", n_batches) + call hdf5_write_integer(hdf5_output_file, "n_inactive", n_inactive) + call hdf5_write_integer(hdf5_output_file, "n_active", n_active) + call hdf5_write_integer(hdf5_output_file, "gen_per_batch", gen_per_batch) + + ! Add description of each variable + call h5ltset_attribute_string_f(hdf5_output_file, "n_particles", & + "description", "Number of particles per generation", hdf5_err) + call h5ltset_attribute_string_f(hdf5_output_file, "n_batches", & + "description", "Total number of batches", hdf5_err) + call h5ltset_attribute_string_f(hdf5_output_file, "n_inactive", & + "description", "Number of inactive batches", hdf5_err) + call h5ltset_attribute_string_f(hdf5_output_file, "n_active", & + "description", "Number of active batches", hdf5_err) + call h5ltset_attribute_string_f(hdf5_output_file, "gen_per_batch", & + "description", "Number of generations per batch", hdf5_err) + end if + + call hdf5_write_geometry() + call hdf5_write_materials() + call hdf5_write_nuclides() + if (n_tallies > 0) then + call hdf5_write_tallies() + end if + + ! Terminate access to the file. + call h5fclose_f(hdf5_output_file, hdf5_err) + + end subroutine hdf5_write_summary + +!=============================================================================== +! HDF5_WRITE_HEADER +!=============================================================================== + + subroutine hdf5_write_header() + + ! Write version information + call hdf5_write_integer(hdf5_output_file, "version_major", VERSION_MAJOR) + call hdf5_write_integer(hdf5_output_file, "version_minor", VERSION_MINOR) + call hdf5_write_integer(hdf5_output_file, "version_release", VERSION_RELEASE) + + ! Write current date and time + call h5ltmake_dataset_string_f(hdf5_output_file, "date_and_time", & + time_stamp(), hdf5_err) + + ! Write MPI information + call hdf5_write_integer(hdf5_output_file, "n_procs", n_procs) + call h5ltset_attribute_string_f(hdf5_output_file, "n_procs", & + "description", "Number of MPI processes", hdf5_err) + + end subroutine hdf5_write_header + +!=============================================================================== +! HDF5_WRITE_GEOMETRY +!=============================================================================== + + subroutine hdf5_write_geometry() + + integer :: i, j, k, m + integer :: n_x, n_y, n_z + integer(HSIZE_T) :: dims(1) + integer(HSIZE_T) :: dims3(3) + integer(HID_T) :: geometry_group + integer(HID_T) :: cell_group + integer(HID_T) :: surface_group + integer(HID_T) :: universe_group + integer(HID_T) :: lattice_group + integer(HID_T) :: temp_group + integer, allocatable :: lattice_universes(:,:,:) + type(Cell), pointer :: c => null() + type(Surface), pointer :: s => null() + type(Universe), pointer :: u => null() + type(Lattice), pointer :: lat => null() + + ! Create group for geometry + call h5gcreate_f(hdf5_output_file, "/geometry", geometry_group, hdf5_err) + + ! Use H5LT interface to write number of geometry objects + call hdf5_write_integer(geometry_group, "n_cells", n_cells) + call hdf5_write_integer(geometry_group, "n_surfaces", n_surfaces) + call hdf5_write_integer(geometry_group, "n_universes", n_universes) + call hdf5_write_integer(geometry_group, "n_lattices", n_lattices) + + ! ========================================================================== + ! WRITE INFORMATION ON CELLS + + call h5gcreate_f(geometry_group, "cells", cell_group, hdf5_err) + + ! Write information on each cell + do i = 1, n_cells + c => cells(i) + + ! Create group for i-th cell + call h5gcreate_f(cell_group, "cell " // trim(to_str(c % id)), & + temp_group, hdf5_err) + + ! Write universe for this cell + call hdf5_write_integer(temp_group, "universe", & + universes(c % universe) % id) + + ! Write information on what fills this cell + select case (c % type) + case (CELL_NORMAL) + call h5ltmake_dataset_string_f(temp_group, "fill_type", "normal", & + hdf5_err) + if (c % material == MATERIAL_VOID) then + call hdf5_write_integer(temp_group, "material", -1) + else + call hdf5_write_integer(temp_group, "material", & + materials(c % material) % id) + end if + case (CELL_FILL) + call h5ltmake_dataset_string_f(temp_group, "fill_type", "universe", & + hdf5_err) + call hdf5_write_integer(temp_group, "material", & + universes(c % fill) % id) + case (CELL_LATTICE) + call h5ltmake_dataset_string_f(temp_group, "fill_type", "lattice", & + hdf5_err) + call hdf5_write_integer(temp_group, "lattice", & + lattices(c % fill) % id) + end select + + ! Write list of bounding surfaces + if (c % n_surfaces > 0) then + dims(1) = c % n_surfaces + call h5ltmake_dataset_int_f(temp_group, "surfaces", 1, & + dims, c % surfaces, hdf5_err) + end if + + ! Close group for i-th cell + call h5gclose_f(temp_group, hdf5_err) + end do + + call h5gclose_f(cell_group, hdf5_err) + + ! ========================================================================== + ! WRITE INFORMATION ON SURFACES + + call h5gcreate_f(geometry_group, "surfaces", surface_group, hdf5_err) + + ! Write information on each surface + do i = 1, n_surfaces + s => surfaces(i) + + ! Create group for i-th surface + call h5gcreate_f(surface_group, "surface " // trim(to_str(s % id)), & + temp_group, hdf5_err) + + ! Write surface type + select case (s % type) + case (SURF_PX) + call h5ltmake_dataset_string_f(temp_group, "type", "X Plane", hdf5_err) + case (SURF_PY) + call h5ltmake_dataset_string_f(temp_group, "type", "Y Plane", hdf5_err) + case (SURF_PZ) + call h5ltmake_dataset_string_f(temp_group, "type", "Z Plane", hdf5_err) + case (SURF_PLANE) + call h5ltmake_dataset_string_f(temp_group, "type", "Plane", hdf5_err) + case (SURF_CYL_X) + call h5ltmake_dataset_string_f(temp_group, "type", "X Cylinder", hdf5_err) + case (SURF_CYL_Y) + call h5ltmake_dataset_string_f(temp_group, "type", "Y Cylinder", hdf5_err) + case (SURF_CYL_Z) + call h5ltmake_dataset_string_f(temp_group, "type", "Z Cylinder", hdf5_err) + case (SURF_SPHERE) + call h5ltmake_dataset_string_f(temp_group, "type", "Sphere", hdf5_err) + case (SURF_CONE_X) + call h5ltmake_dataset_string_f(temp_group, "type", "X Cone", hdf5_err) + case (SURF_CONE_Y) + call h5ltmake_dataset_string_f(temp_group, "type", "Y Cone", hdf5_err) + case (SURF_CONE_Z) + call h5ltmake_dataset_string_f(temp_group, "type", "Z Cone", hdf5_err) + end select + + ! Write coefficients for surface + dims(1) = size(s % coeffs) + call h5ltmake_dataset_double_f(temp_group, "coefficients", 1, dims, & + s % coeffs, hdf5_err) + + ! Write positive neighbors + if (allocated(s % neighbor_pos)) then + dims(1) = size(s % neighbor_pos) + call h5ltmake_dataset_int_f(temp_group, "neighbors_positive", 1, dims, & + s % neighbor_pos, hdf5_err) + end if + + ! Write negative neighbors + if (allocated(s % neighbor_neg)) then + dims(1) = size(s % neighbor_neg) + call h5ltmake_dataset_int_f(temp_group, "neighbors_negative", 1, dims, & + s % neighbor_neg, hdf5_err) + end if + + ! Write boundary condition + select case (s % bc) + case (BC_TRANSMIT) + call h5ltmake_dataset_string_f(temp_group, "boundary_condition", & + "transmission", hdf5_err) + case (BC_VACUUM) + call h5ltmake_dataset_string_f(temp_group, "boundary_condition", & + "vacuum", hdf5_err) + case (BC_REFLECT) + call h5ltmake_dataset_string_f(temp_group, "boundary_condition", & + "reflective", hdf5_err) + case (BC_PERIODIC) + call h5ltmake_dataset_string_f(temp_group, "boundary_condition", & + "periodic", hdf5_err) + end select + + ! Close group for i-th surface + call h5gclose_f(temp_group, hdf5_err) + end do + + call h5gclose_f(surface_group, hdf5_err) + + ! ========================================================================== + ! WRITE INFORMATION ON UNIVERSES + + call h5gcreate_f(geometry_group, "universes", universe_group, hdf5_err) + + ! Write information on each universe + do i = 1, n_universes + u => universes(i) + + ! Create group for i-th universe + call h5gcreate_f(universe_group, "universe " // trim(to_str(u % id)), & + temp_group, hdf5_err) + + ! Write list of cells in this universe + if (u % n_cells > 0) then + dims(1) = u % n_cells + call h5ltmake_dataset_int_f(temp_group, "cells", 1, dims, & + u % cells, hdf5_err) + end if + + ! Close group for i-th universe + call h5gclose_f(temp_group, hdf5_err) + end do + + call h5gclose_f(universe_group, hdf5_err) + + ! ========================================================================== + ! WRITE INFORMATION ON LATTICES + + call h5gcreate_f(geometry_group, "lattices", lattice_group, hdf5_err) + + ! Write information on each lattice + do i = 1, n_lattices + lat => lattices(i) + + ! Create group for i-th lattice + call h5gcreate_f(lattice_group, "lattice " // trim(to_str(lat % id)), & + temp_group, hdf5_err) + + ! Write lattice type + select case(lat % type) + case (LATTICE_RECT) + call h5ltmake_dataset_string_f(temp_group, "type", "rectangular", hdf5_err) + case (LATTICE_HEX) + call h5ltmake_dataset_string_f(temp_group, "type", "hexagonal", hdf5_err) + end select + + ! Write lattice dimensions, lower left corner, and width of element + dims(1) = lat % n_dimension + call h5ltmake_dataset_int_f(temp_group, "dimension", 1, dims, & + lat % dimension, hdf5_err) + call h5ltmake_dataset_double_f(temp_group, "lower_left", 1, dims, & + lat % lower_left, hdf5_err) + call h5ltmake_dataset_double_f(temp_group, "width", 1, dims, & + lat % width, hdf5_err) + + ! Determine dimensions of lattice + n_x = lat % dimension(1) + n_y = lat % dimension(2) + if (lat % n_dimension == 3) then + n_z = lat % dimension(3) + else + n_z = 1 + end if + + ! Write lattice universes + allocate(lattice_universes(n_x, n_y, n_z)) + do j = 1, n_x + do k = 1, n_y + do m = 1, n_z + lattice_universes(j,k,m) = universes(lat % universes(j,k,m)) % id + end do + end do + end do + dims3 = (/ n_x, n_y, n_z /) + call h5ltmake_dataset_int_f(temp_group, "universes", 3, dims3, & + lattice_universes, hdf5_err) + deallocate(lattice_universes) + + ! Close group for i-th lattice + call h5gclose_f(temp_group, hdf5_err) + end do + + call h5gclose_f(lattice_group, hdf5_err) + + ! Close geometry group + call h5gclose_f(geometry_group, hdf5_err) + + end subroutine hdf5_write_geometry + +!=============================================================================== +! HDF5_WRITE_MATERIALS +!=============================================================================== + + subroutine hdf5_write_materials() + + integer :: i + integer :: j + integer(HSIZE_T) :: dims(1) + integer(HID_T) :: materials_group + integer(HID_T) :: temp_group + integer, allocatable :: zaids(:) + type(Material), pointer :: m => null() + + ! Create group for materials + call h5gcreate_f(hdf5_output_file, "/materials", materials_group, hdf5_err) + + ! Use H5LT interface to write number of materials + call hdf5_write_integer(materials_group, "n_materials", n_materials) + + ! Write information on each material + do i = 1, n_materials + m => materials(i) + + ! Create group for i-th universe + call h5gcreate_f(materials_group, "material " // trim(to_str(m % id)), & + temp_group, hdf5_err) + + ! Write atom density with units + call hdf5_write_double(temp_group, "atom_density", m % density) + call h5ltset_attribute_string_f(temp_group, "atom_density", & + "units", "atom/barn-cm", hdf5_err) + + ! Copy ZAID for each nuclide to temporary array + allocate(zaids(m % n_nuclides)) + do j = 1, m % n_nuclides + zaids(j) = nuclides(m % nuclide(j)) % zaid + end do + + ! Write temporary array to 'nuclides' + dims(1) = m % n_nuclides + call h5ltmake_dataset_int_f(temp_group, "nuclides", 1, & + dims, zaids, hdf5_err) + + ! Deallocate temporary array + deallocate(zaids) + + ! Write atom densities + call h5ltmake_dataset_double_f(temp_group, "nuclide_densities", 1, & + dims, m % atom_density, hdf5_err) + + ! Write S(a,b) information if present + if (m % n_sab > 0) then + dims(1) = m % n_sab + call h5ltmake_dataset_int_f(temp_group, "i_sab_nuclides", 1, & + dims, m % i_sab_nuclides, hdf5_err) + call h5ltmake_dataset_int_f(temp_group, "i_sab_tables", 1, & + dims, m % i_sab_tables, hdf5_err) + end if + + ! Close group for i-th material + call h5gclose_f(temp_group, hdf5_err) + end do + + ! Close materials group + call h5gclose_f(materials_group, hdf5_err) + + end subroutine hdf5_write_materials + +!=============================================================================== +! HDF5_WRITE_TALLIES +!=============================================================================== + + subroutine hdf5_write_tallies() + + integer :: i, j + integer(HSIZE_T) :: dims(1) + integer(HID_T) :: tallies_group + integer(HID_T) :: temp_group + integer(HID_T) :: filter_group ! group for i-th filter + integer, allocatable :: temp_array(:) ! nuclide bin array + type(TallyObject), pointer :: t => null() + + ! Create group for tallies + call h5gcreate_f(hdf5_output_file, "tallies", tallies_group, hdf5_err) + + ! Write total number of meshes + call hdf5_write_integer(tallies_group, "n_meshes", n_meshes) + + ! Write information for meshes + MESH_LOOP: do i = 1, n_meshes + ! Create temporary group for each mesh + call h5gcreate_f(tallies_group, "mesh" // to_str(i), & + temp_group, hdf5_err) + + ! Write type and number of dimensions + call hdf5_write_integer(temp_group, "type", meshes(i) % type) + call hdf5_write_integer(temp_group, "n_dimension", & + meshes(i) % n_dimension) + + ! Write mesh information + dims(1) = meshes(i) % n_dimension + call h5ltmake_dataset_int_f(temp_group, "dimension", 1, & + dims, meshes(i) % dimension, hdf5_err) + call h5ltmake_dataset_double_f(temp_group, "lower_left", 1, & + dims, meshes(i) % lower_left, hdf5_err) + call h5ltmake_dataset_double_f(temp_group, "upper_right", 1, & + dims, meshes(i) % upper_right, hdf5_err) + call h5ltmake_dataset_double_f(temp_group, "width", 1, & + dims, meshes(i) % width, hdf5_err) + + ! Close temporary group for mesh + call h5gclose_f(temp_group, hdf5_err) + end do MESH_LOOP + + ! Write number of tallies + call hdf5_write_integer(tallies_group, "n_tallies", n_tallies) + + TALLY_METADATA: do i = 1, n_tallies + ! Get pointer to tally + t => tallies(i) + + ! Create group for this tally + call h5gcreate_f(tallies_group, "tally" // to_str(i), & + temp_group, hdf5_err) + + ! Write size of each tally + call hdf5_write_integer(temp_group, "total_score_bins", & + t % total_score_bins) + call hdf5_write_integer(temp_group, "total_filter_bins", & + t % total_filter_bins) + + ! Write number of filters + call hdf5_write_integer(temp_group, "n_filters", t % n_filters) + + FILTER_LOOP: do j = 1, t % n_filters + ! Create filter group + call h5gcreate_f(temp_group, "filter" // to_str(j), filter_group, & + hdf5_err) + + ! Write type of filter + call hdf5_write_integer(filter_group, "type", t % filters(j) % type) + + ! Write number of bins for this filter + call hdf5_write_integer(filter_group, "n_bins", t % filters(j) % n_bins) + + ! Write filter bins + if (t % filters(j) % type == FILTER_ENERGYIN .or. & + t % filters(j) % type == FILTER_ENERGYOUT) then + dims(1) = size(t % filters(j) % real_bins) + call h5ltmake_dataset_double_f(filter_group, "bins", 1, & + dims, t % filters(j) % real_bins, hdf5_err) + else + dims(1) = size(t % filters(j) % int_bins) + call h5ltmake_dataset_int_f(filter_group, "bins", 1, & + dims, t % filters(j) % int_bins, hdf5_err) + end if + + ! Write name of type + select case (t % filters(j) % type) + case(FILTER_UNIVERSE) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "universe", hdf5_err) + case(FILTER_MATERIAL) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "material", hdf5_err) + case(FILTER_CELL) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "cell", hdf5_err) + case(FILTER_CELLBORN) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "cellborn", hdf5_err) + case(FILTER_SURFACE) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "surface", hdf5_err) + case(FILTER_MESH) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "mesh", hdf5_err) + case(FILTER_ENERGYIN) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "energy", hdf5_err) + case(FILTER_ENERGYOUT) + call h5ltmake_dataset_string_f(filter_group, "type_name", & + "energyout", hdf5_err) + end select + + ! Close group for this filter + call h5gclose_f(filter_group, hdf5_err) + end do FILTER_LOOP + + ! Write number of nuclide bins + call hdf5_write_integer(temp_group, "n_nuclide_bins", & + t % n_nuclide_bins) + + + ! Create temporary array for nuclide bins + allocate(temp_array(t % n_nuclide_bins)) + NUCLIDE_LOOP: do j = 1, t % n_nuclide_bins + if (t % nuclide_bins(j) > 0) then + temp_array(j) = nuclides(t % nuclide_bins(j)) % zaid + else + temp_array(j) = t % nuclide_bins(j) + end if + end do NUCLIDE_LOOP + + ! Write and deallocate nuclide bins + dims(1) = t % n_nuclide_bins + call h5ltmake_dataset_int_f(temp_group, "nuclide_bins", 1, & + dims, temp_array, hdf5_err) + deallocate(temp_array) + + ! Write number of score bins + call hdf5_write_integer(temp_group, "n_score_bins", & + t % n_score_bins) + dims(1) = t % n_score_bins + call h5ltmake_dataset_int_f(temp_group, "score_bins", 1, & + dims, t % score_bins, hdf5_err) + + ! Close tally group + call h5gclose_f(temp_group, hdf5_err) + end do TALLY_METADATA + + ! Close tallies group + call h5gclose_f(tallies_group, hdf5_err) + + end subroutine hdf5_write_tallies + +!=============================================================================== +! HDF5_WRITE_NUCLIDES +!=============================================================================== + + subroutine hdf5_write_nuclides() + + integer :: i, j + integer :: size_total + integer :: size_xs + integer :: size_angle + integer :: size_energy + integer(HID_T) :: group + integer(HID_T) :: nuclide_group + integer(HID_T) :: reactions_group + integer(HID_T) :: rxn_group + type(Nuclide), pointer :: nuc => null() + type(Reaction), pointer :: rxn => null() + type(UrrData), pointer :: urr => null() + + ! Create group for nuclides + call h5gcreate_f(hdf5_output_file, "/nuclides", group, hdf5_err) + + ! Use H5LT interface to write number of nuclides + call hdf5_write_integer(group, "n_nuclides", n_nuclides_total) + + ! Write information on each nuclide + do i = 1, n_nuclides_total + nuc => nuclides(i) + + ! Determine size of cross-sections + size_xs = (5 + nuc % n_reaction) * nuc % n_grid * 8 + size_total = size_xs + + ! Create group for i-th nuclide + call h5gcreate_f(group, trim(nuc % name), nuclide_group, hdf5_err) + + ! Write some basic attributes + call hdf5_write_integer(nuclide_group, "zaid", nuc % zaid) + call hdf5_write_double(nuclide_group, "awr", nuc % awr) + call hdf5_write_double(nuclide_group, "kT", nuc % kT) + call hdf5_write_integer(nuclide_group, "n_grid", nuc % n_grid) + call hdf5_write_integer(nuclide_group, "n_reactions", nuc % n_reaction) + call hdf5_write_integer(nuclide_group, "n_fission", nuc % n_fission) + call hdf5_write_integer(nuclide_group, "size_xs", size_xs) + + ! ======================================================================= + ! WRITE INFORMATION ON EACH REACTION + + ! Create overall group + call h5gcreate_f(nuclide_group, "reactions", reactions_group, hdf5_err) + + do j = 1, nuc % n_reaction + ! Information on each reaction + rxn => nuc % reactions(j) + + ! Determine size of angle distribution + if (rxn % has_angle_dist) then + size_angle = rxn % adist % n_energy * 16 + size(rxn % adist % data) * 8 + else + size_angle = 0 + end if + + ! Determine size of energy distribution + if (rxn % has_energy_dist) then + size_energy = size(rxn % edist % data) * 8 + else + size_energy = 0 + end if + + ! Create reaction group + call h5gcreate_f(reactions_group, reaction_name(rxn % MT), & + rxn_group, hdf5_err) + + ! Write information on reaction + call hdf5_write_double(rxn_group, "Q_value", rxn % Q_value) + call hdf5_write_integer(rxn_group, "multiplicity", rxn % multiplicity) + call hdf5_write_integer(rxn_group, "threshold", rxn % threshold) + call hdf5_write_integer(rxn_group, "size_angle", size_angle) + call hdf5_write_integer(rxn_group, "size_energy", size_energy) + + call h5gclose_f(rxn_group, hdf5_err) + + ! Accumulate data size + size_total = size_total + size_angle + size_energy + end do + + ! Close overall group for reactions + call h5gclose_f(reactions_group, hdf5_err) + + ! ======================================================================= + ! WRITE INFORMATION ON URR PROBABILITY TABLES + + if (nuc % urr_present) then + urr => nuc % urr_data + call hdf5_write_integer(nuclide_group, "urr_n_energy", urr % n_energy) + call hdf5_write_integer(nuclide_group, "urr_n_prob", urr % n_prob) + call hdf5_write_integer(nuclide_group, "urr_interp", urr % interp) + call hdf5_write_integer(nuclide_group, "urr_inelastic", urr % inelastic_flag) + call hdf5_write_integer(nuclide_group, "urr_absorption", urr % absorption_flag) + call hdf5_write_double(nuclide_group, "urr_min_E", urr % energy(1)) + call hdf5_write_double(nuclide_group, "urr_max_E", urr % energy(urr % n_energy)) + end if + + ! Write total memory used + call hdf5_write_integer(nuclide_group, "size_total", size_total) + + ! Close group for i-th nuclide + call h5gclose_f(nuclide_group, hdf5_err) + end do + + ! Close group for nuclides + call h5gclose_f(group, hdf5_err) + + end subroutine hdf5_write_nuclides + +!=============================================================================== +! HDF5_WRITE_TIMING +!=============================================================================== + + subroutine hdf5_write_timing() + + integer(HID_T) :: timing_group + integer(8) :: total_particles + real(8) :: speed + + ! Create group for timing + call h5gcreate_f(hdf5_output_file, "/timing", timing_group, hdf5_err) + + ! Write timing data + call hdf5_write_double(timing_group, "time_initialize", time_initialize % elapsed) + call hdf5_write_double(timing_group, "time_read_xs", time_read_xs % elapsed) + call hdf5_write_double(timing_group, "time_unionize", time_unionize % elapsed) + call hdf5_write_double(timing_group, "time_transport", time_transport % elapsed) + call hdf5_write_double(timing_group, "time_bank", time_bank % elapsed) + call hdf5_write_double(timing_group, "time_bank_sample", time_bank_sample % elapsed) + call hdf5_write_double(timing_group, "time_bank_sendrecv", time_bank_sendrecv % elapsed) + call hdf5_write_double(timing_group, "time_tallies", time_tallies % elapsed) + call hdf5_write_double(timing_group, "time_inactive", time_inactive % elapsed) + call hdf5_write_double(timing_group, "time_active", time_active % elapsed) + call hdf5_write_double(timing_group, "time_finalize", time_finalize % elapsed) + call hdf5_write_double(timing_group, "time_total", time_total % elapsed) + + ! Add descriptions to timing data + call h5ltset_attribute_string_f(timing_group, "time_initialize", & + "description", "Total time elapsed for initialization (s)", hdf5_err) + call h5ltset_attribute_string_f(timing_group, "time_read_xs", & + "description", "Time reading cross-section libraries (s)", hdf5_err) + call h5ltset_attribute_string_f(timing_group, "time_unionize", & + "description", "Time unionizing energy grid (s)", hdf5_err) + call h5ltset_attribute_string_f(timing_group, "time_transport", & + "description", "Time in transport only (s)", hdf5_err) + call h5ltset_attribute_string_f(timing_group, "time_bank", & + "description", "Total time synchronizing fission bank (s)", hdf5_err) + call h5ltset_attribute_string_f(timing_group, "time_bank_sample", & + "description", "Time between generations sampling source sites (s)", hdf5_err) + call h5ltset_attribute_string_f(timing_group, "time_bank_sendrecv", & + "description", "Time between generations SEND/RECVing source sites (s)", hdf5_err) + call h5ltset_attribute_string_f(timing_group, "time_tallies", & + "description", "Time between batches accumulating tallies (s)", hdf5_err) + call h5ltset_attribute_string_f(timing_group, "time_inactive", & + "description", "Total time in inactive batches (s)", hdf5_err) + call h5ltset_attribute_string_f(timing_group, "time_active", & + "description", "Total time in active batches (s)", hdf5_err) + call h5ltset_attribute_string_f(timing_group, "time_finalize", & + "description", "Total time for finalization (s)", hdf5_err) + call h5ltset_attribute_string_f(timing_group, "time_total", & + "description", "Total time elapsed (s)", hdf5_err) + + ! Write calculation rate + total_particles = n_particles * n_batches * gen_per_batch + speed = real(total_particles) / (time_inactive % elapsed + & + time_active % elapsed) + call hdf5_write_double(timing_group, "neutrons_per_second", speed) + + ! Close timing group + call h5gclose_f(timing_group, hdf5_err) + + end subroutine hdf5_write_timing + +#endif + +end module hdf5_summary diff --git a/src/initialize.F90 b/src/initialize.F90 index 5025305d65..3c6cde1aef 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -26,6 +26,7 @@ module initialize #ifdef HDF5 use hdf5_interface + use hdf5_summary, only: hdf5_write_summary #endif implicit none diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 2d456717a3..4cc164b7ed 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -386,7 +386,7 @@ contains else temp_group = hdf5_fh endif - call hdf5_write_long(temp_group, name, buffer) + call hdf5_write_long(temp_group, name, buffer, hdf5_integer8_t) if (present(group)) call hdf5_close_group() #elif MPI call mpi_write_long(mpi_fh, buffer) @@ -412,7 +412,7 @@ contains else temp_group = hdf5_fh endif - call hdf5_read_long(temp_group, name, buffer) + call hdf5_read_long(temp_group, name, buffer, hdf5_integer8_t) if (present(group)) call hdf5_close_group() #elif MPI call mpi_read_long(mpi_fh, buffer) diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index 07c7f5475e..20da7f9987 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -53,8 +53,8 @@ contains 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) - call hdf5_read_long(hdf5_particle_file, 'id', p % id) + 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/) From fd94d7e433b15b428b03dfbc101dadf1dd60cfb8 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Mon, 13 May 2013 08:57:06 -0700 Subject: [PATCH 16/65] fixed dependency in particle restart write --- src/particle_restart_write.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/particle_restart_write.F90 b/src/particle_restart_write.F90 index 96cc587a6e..816e910656 100644 --- a/src/particle_restart_write.F90 +++ b/src/particle_restart_write.F90 @@ -63,8 +63,8 @@ contains 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) - call hdf5_write_long(hdf5_particle_file, 'id', p % id) + 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/) From 4b5cf8c02eedbd5fcd669b7986a7d9cc9eae42bb Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Mon, 13 May 2013 14:30:11 -0700 Subject: [PATCH 17/65] fixed how output file are opened and closed for statepoint and source files --- src/constants.F90 | 1 - src/hdf5_interface.F90 | 18 +++++++ src/output_interface.F90 | 104 ++++++++++++++------------------------- src/state_point.F90 | 28 +++++------ 4 files changed, 67 insertions(+), 84 deletions(-) diff --git a/src/constants.F90 b/src/constants.F90 index 5700bd9084..04f757db9c 100644 --- a/src/constants.F90 +++ b/src/constants.F90 @@ -360,7 +360,6 @@ module constants integer, parameter :: UNIT_STATE = 16 ! unit # for writing state point integer, parameter :: CMFD_BALANCE = 17 ! unit # for writing cmfd balance file integer, parameter :: UNIT_PARTICLE = 18 ! unit # for writing particle restart - integer, parameter :: UNIT_OUTPUT = 19 ! unit # for writing output files !============================================================================= ! CMFD CONSTANTS diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 3470aadf85..06cb66aefb 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -17,6 +17,24 @@ module hdf5_interface integer(HID_T) :: temp_group integer :: hdf5_err + interface hdf5_write_data + module procedure hdf5_write_double + module procedure hdf5_write_double_1Darray + module procedure hdf5_write_integer + module procedure hdf5_write_integer_1Darray + module procedure hdf5_write_long + module procedure hdf5_write_string + end interface hdf5_write_data + + interface hdf5_read_data + module procedure hdf5_read_double + module procedure hdf5_read_double_1Darray + module procedure hdf5_read_integer + module procedure hdf5_read_integer_1Darray + module procedure hdf5_read_long + module procedure hdf5_read_string + end interface hdf5_read_data + contains !=============================================================================== diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 4cc164b7ed..a5437924b3 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -38,43 +38,32 @@ contains ! FILE_CREATE !=============================================================================== - subroutine file_create(filename, fh_str) + subroutine file_create(filename, fh_str, unit_) character(*) :: filename - character(MAX_WORD_LEN) :: fh_str + character(*) :: fh_str + integer, optional :: unit_ + +#ifdef HDF5 + filename = trim(filename) // '.h5' +#else + filename = trim(filename) // '.binary' +#endif #ifdef HDF5 # ifdef MPI - if (trim(fh_str) == 'state_point') then - if(master) call hdf5_file_create(trim(trim(filename) // '.h5'), & - hdf5_fh) - else - call hdf5_parallel_file_create(trim(filename) // '.h5', & - hdf5_fh) + if (trim(fh_str) == 'serial') then + if(master) call hdf5_file_create(filename, hdf5_fh) + else + call hdf5_parallel_file_create(filename, hdf5_fh) endif # else - if (trim(fh_str) == 'state_point') then - call hdf5_file_create(trim(filename) // '.h5', & - hdf5_fh) - else - call hdf5_file_create(trim(filename) // '.h5', & - hdf5_fh) - endif + call hdf5_file_create(filename, hdf5_fh) # endif #elif MPI - if (trim(fh_str) == 'state_point') then - call mpi_file_create(trim(filename) // '.binary' , mpi_fh) - else - call mpi_file_create(trim(filename) // '.binary', mpi_fh) - endif + call mpi_file_create(filename, mpi_fh) #else - if (trim(fh_str) == 'state_point') then - open(UNIT=UNIT_OUTPUT, FILE=trim(filename) // '.binary', STATUS='replace', & - ACCESS='stream') - else - open(UNIT=UNIT_OUTPUT, FILE=trim(filename) // '.binary', STATUS='replace', & - ACCESS='stream') - endif + open(UNIT=unit_, FILE=filename, STATUS='replace', ACCESS='stream') #endif end subroutine file_create @@ -83,43 +72,32 @@ contains ! FILE_OPEN !=============================================================================== - subroutine file_open(filename, fh_str) + subroutine file_open(filename, fh_str, unit_) character(*) :: filename - character(MAX_WORD_LEN) :: fh_str + character(*) :: fh_str + integer, optional :: unit_ + +#ifdef HDF5 + filename = trim(filename) // '.h5' +#else + filename = trim(filename) // '.binary' +#endif #ifdef HDF5 # ifdef MPI - if (trim(fh_str) == 'state_point') then - call hdf5_file_open(trim(trim(filename) // '.h5'), & - hdf5_fh) - else - call hdf5_parallel_file_open(trim(filename) // '.h5', & - hdf5_fh) + if (trim(fh_str) == 'serial') then + call hdf5_file_open(filename, hdf5_fh) + else + call hdf5_parallel_file_open(filename, hdf5_fh) endif # else - if (trim(fh_str) == 'state_point') then - call hdf5_file_open(trim(filename) // '.h5', & - hdf5_fh) - else - call hdf5_file_open(trim(filename) // '.h5', & - hdf5_fh) - endif + call hdf5_file_open(filename, hdf5_fh) # endif #elif MPI - if (trim(fh_str) == 'state_point') then - call mpi_file_open(trim(filename) // '.binary' , mpi_fh) - else - call mpi_file_open(trim(filename) // '.binary', mpi_fh) - endif + call mpi_file_open(filename, mpi_fh) #else - if (trim(fh_str) == 'state_point') then - open(UNIT=UNIT_OUTPUT, FILE=trim(filename) // '.binary', STATUS='old', & - ACCESS='stream') - else - open(UNIT=UNIT_OUTPUT, FILE=trim(filename) // '.binary', STATUS='old', & - ACCESS='stream') - endif + open(UNIT=unit_, FILE=filename, STATUS='old', ACCESS='stream') #endif end subroutine file_open @@ -128,13 +106,14 @@ contains ! FILE_CLOSE !=============================================================================== - subroutine file_close(fh_str) + subroutine file_close(fh_str, unit_) - character(MAX_WORD_LEN) :: fh_str + character(*) :: fh_str + integer, optional :: unit_ #ifdef HDF5 # ifdef MPI - if (trim(fh_str) == 'state_point') then + if (trim(fh_str) == 'serial') then if(master) call hdf5_file_close(hdf5_fh) else call hdf5_file_close(hdf5_fh) @@ -143,17 +122,9 @@ contains call hdf5_file_close(hdf5_fh) # endif #elif MPI - if (trim(fh_str) == 'state_point') then - call mpi_close_file(mpi_fh) - else call mpi_close_file(mpi_fh) - endif #else - if (trim(fh_str) == 'state_point') then - close(UNIT=UNIT_OUTPUT) - else - close(UNIT=UNIT_OUTPUT) - endif + close(UNIT=unit_) #endif end subroutine file_close @@ -574,7 +545,6 @@ contains #ifdef HDF5 integer :: hdf5_err integer(HSIZE_T) :: dims(1) - integer(HID_T) :: dspace integer(HID_T) :: dset type(c_ptr) :: f_ptr #elif MPI diff --git a/src/state_point.F90 b/src/state_point.F90 index 65321a34d1..b053a382fa 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -32,8 +32,6 @@ contains subroutine write_state_point() character(MAX_FILE_LEN) :: filename - character(MAX_WORD_LEN) :: fh_state_point = "state_point" - character(MAX_WORD_LEN) :: fh_source = "source" integer :: i integer :: j integer, allocatable :: temp_array(:) @@ -48,7 +46,7 @@ contains call write_message(1) ! Create statepoint file - call file_create(filename, fh_state_point) + call file_create(filename, 'serial', UNIT_STATE) if (master) then @@ -253,7 +251,7 @@ contains if (source_separate) then ! Close statepoint file - call file_close(fh_state_point) + call file_close('serial', UNIT_STATE) ! Set filename for source filename = trim(path_output) // 'source.' // & @@ -264,7 +262,7 @@ contains call write_message(1) ! Create statepoint file - call file_create(filename, fh_source) + call file_create(filename, 'parallel', UNIT_SOURCE) end if @@ -273,15 +271,15 @@ contains ! Close file if (source_separate) then - call file_close(fh_source) + call file_close('parallel', UNIT_SOURCE) else - call file_close(fh_state_point) + call file_close('serial', UNIT_STATE) end if else ! Close file if not in eigenvalue mode or no source writing - call file_close(fh_state_point) + call file_close('serial', UNIT_STATE) end if @@ -295,8 +293,6 @@ contains character(MAX_FILE_LEN) :: filename character(MAX_FILE_LEN) :: path_temp - character(MAX_WORD_LEN) :: fh_state_point = "state_point" - character(MAX_WORD_LEN) :: fh_source = "source" character(19) :: current_time integer :: i integer :: j @@ -310,7 +306,7 @@ contains call write_message(1) ! Open file for reading - call file_open(path_state_point, fh_state_point) + call file_open(path_state_point, 'serial', UNIT_STATE) ! Read revision number for state point file and make sure it matches with ! current version @@ -530,7 +526,7 @@ contains if (source_separate) then ! Close statepoint file - call file_close(fh_state_point) + call file_close('serial', UNIT_STATE) ! Set filename for source filename = trim(path_output) // 'source.' // & @@ -541,7 +537,7 @@ contains call write_message(1) ! Create statepoint file - call file_open(filename, fh_source) + call file_open(filename, 'parallel', UNIT_SOURCE) end if @@ -550,15 +546,15 @@ contains ! Close file if (source_separate) then - call file_close(fh_source) + call file_close('parallel', UNIT_SOURCE) else - call file_close(fh_state_point) + call file_close('serial', UNIT_STATE) end if else ! Close file if not in eigenvalue mode - call file_close(fh_state_point) + call file_close('serial', UNIT_STATE) end if From a01d53c165d87fa4ff0b46e73b26b4c359d77959 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Mon, 13 May 2013 15:58:03 -0700 Subject: [PATCH 18/65] checked different combinations of HDF5 and MPI with intel and fixed bugs --- src/constants.F90 | 7 ++- src/mpi_interface.F90 | 109 +++++++++++++++++++++++++++++++++++++-- src/output_interface.F90 | 23 ++++----- src/state_point.F90 | 24 ++++----- 4 files changed, 131 insertions(+), 32 deletions(-) diff --git a/src/constants.F90 b/src/constants.F90 index 04f757db9c..56868fa4fe 100644 --- a/src/constants.F90 +++ b/src/constants.F90 @@ -356,10 +356,9 @@ module constants integer, parameter :: UNIT_TALLY = 12 ! unit # for writing tally file integer, parameter :: UNIT_PLOT = 13 ! unit # for writing plot file integer, parameter :: UNIT_XS = 14 ! unit # for writing xs summary file - integer, parameter :: UNIT_SOURCE = 15 ! unit # for writing source file - integer, parameter :: UNIT_STATE = 16 ! unit # for writing state point - integer, parameter :: CMFD_BALANCE = 17 ! unit # for writing cmfd balance file - integer, parameter :: UNIT_PARTICLE = 18 ! unit # for writing particle restart + integer, parameter :: CMFD_BALANCE = 15 ! unit # for writing cmfd balance file + integer, parameter :: UNIT_PARTICLE = 16 ! unit # for writing particle restart + integer, parameter :: UNIT_OUTPUT = 17 ! unit # for writing output !============================================================================= ! CMFD CONSTANTS diff --git a/src/mpi_interface.F90 b/src/mpi_interface.F90 index d7c47d895a..4a063b75ba 100644 --- a/src/mpi_interface.F90 +++ b/src/mpi_interface.F90 @@ -14,10 +14,10 @@ module mpi_interface contains !=============================================================================== -! MPI_FILE_CREATE +! MPI_CREATE_FILE !=============================================================================== - subroutine mpi_file_create(filename, fh) + subroutine mpi_create_file(filename, fh) character(*) :: filename integer, intent(in) :: fh @@ -26,7 +26,22 @@ contains call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, MPI_MODE_CREATE + & MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpi_err) - end subroutine mpi_file_create + end subroutine mpi_create_file + +!=============================================================================== +! MPI_OPEN_FILE +!=============================================================================== + + subroutine mpi_open_file(filename, fh) + + character(*) :: filename + integer, intent(in) :: fh + + ! Create the file + call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, & + MPI_MODE_RDONLY, MPI_INFO_NULL, fh, mpi_err) + + end subroutine mpi_open_file !=============================================================================== ! MPI_CLOSE_FILE @@ -126,5 +141,93 @@ contains MPI_STATUS_IGNORE, mpi_err) end subroutine mpi_write_string + +!=============================================================================== +! MPI_READ_INTEGER +!=============================================================================== + + subroutine mpi_read_integer(fh, buffer) + + integer, intent(in) :: fh + integer, intent(inout) :: buffer + + call MPI_FILE_READ(fh, buffer, 1, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + + end subroutine mpi_read_integer + +!=============================================================================== +! MPI_READ_INTEGER_1DARRAY +!=============================================================================== + + subroutine mpi_read_integer_1Darray(fh, buffer, length) + + integer, intent(in) :: fh + integer, intent(in) :: length + integer, intent(inout) :: buffer(:) + + call MPI_FILE_READ(fh, buffer, length, MPI_INTEGER, & + MPI_STATUS_IGNORE, mpi_err) + + end subroutine mpi_read_integer_1Darray + +!=============================================================================== +! MPI_READ_LONG +!=============================================================================== + + subroutine mpi_read_long(fh, buffer) + + integer, intent(in) :: fh + integer(8), intent(inout) :: buffer + + call MPI_FILE_READ(fh, buffer, 1, MPI_INTEGER8, & + MPI_STATUS_IGNORE, mpi_err) + + end subroutine mpi_read_long + +!=============================================================================== +! MPI_READ_DOUBLE +!=============================================================================== + + subroutine mpi_read_double(fh, buffer) + + integer, intent(in) :: fh + real(8), intent(inout) :: buffer + + call MPI_FILE_READ(fh, buffer, 1, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + + end subroutine mpi_read_double + +!=============================================================================== +! MPI_READ_DOUBLE_1DARRAY +!=============================================================================== + + subroutine mpi_read_double_1Darray(fh, buffer, length) + + integer, intent(in) :: fh + integer, intent(in) :: length + real(8), intent(inout) :: buffer(:) + + call MPI_FILE_READ(fh, buffer, length, MPI_REAL8, & + MPI_STATUS_IGNORE, mpi_err) + + end subroutine mpi_read_double_1Darray + +!=============================================================================== +! MPI_READ_STRING +!=============================================================================== + + subroutine mpi_read_string(fh, buffer, length) + + character(*), intent(inout) :: buffer + integer, intent(in) :: fh + integer, intent(in) :: length + + call MPI_FILE_READ(fh, buffer, length, MPI_CHARACTER, & + MPI_STATUS_IGNORE, mpi_err) + + end subroutine mpi_read_string + #endif end module mpi_interface diff --git a/src/output_interface.F90 b/src/output_interface.F90 index a5437924b3..1a7ddad88b 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -38,11 +38,10 @@ contains ! FILE_CREATE !=============================================================================== - subroutine file_create(filename, fh_str, unit_) + subroutine file_create(filename, fh_str) character(*) :: filename character(*) :: fh_str - integer, optional :: unit_ #ifdef HDF5 filename = trim(filename) // '.h5' @@ -61,9 +60,9 @@ contains call hdf5_file_create(filename, hdf5_fh) # endif #elif MPI - call mpi_file_create(filename, mpi_fh) + call mpi_create_file(filename, mpi_fh) #else - open(UNIT=unit_, FILE=filename, STATUS='replace', ACCESS='stream') + open(UNIT=UNIT_OUTPUT, FILE=filename, STATUS='replace', ACCESS='stream') #endif end subroutine file_create @@ -72,11 +71,10 @@ contains ! FILE_OPEN !=============================================================================== - subroutine file_open(filename, fh_str, unit_) + subroutine file_open(filename, fh_str) character(*) :: filename character(*) :: fh_str - integer, optional :: unit_ #ifdef HDF5 filename = trim(filename) // '.h5' @@ -95,9 +93,9 @@ contains call hdf5_file_open(filename, hdf5_fh) # endif #elif MPI - call mpi_file_open(filename, mpi_fh) + call mpi_open_file(filename, mpi_fh) #else - open(UNIT=unit_, FILE=filename, STATUS='old', ACCESS='stream') + open(UNIT=UNIT_OUTPUT, FILE=filename, STATUS='old', ACCESS='stream') #endif end subroutine file_open @@ -106,10 +104,9 @@ contains ! FILE_CLOSE !=============================================================================== - subroutine file_close(fh_str, unit_) + subroutine file_close(fh_str) character(*) :: fh_str - integer, optional :: unit_ #ifdef HDF5 # ifdef MPI @@ -124,7 +121,7 @@ contains #elif MPI call mpi_close_file(mpi_fh) #else - close(UNIT=unit_) + close(UNIT=UNIT_OUTPUT) #endif end subroutine file_close @@ -540,7 +537,7 @@ contains character(*), intent(in), optional :: group character(*), intent(in) :: name integer, intent(in) :: n1, n2 - type(TallyResult), intent(in) :: buffer(n1, n2) + type(TallyResult), intent(inout) :: buffer(n1, n2) #ifdef HDF5 integer :: hdf5_err @@ -785,7 +782,7 @@ contains dims(1) = work ! Open dataset - call h5dcreate_f(hdf5_fh, "source_bank", dset, hdf5_err) + call h5dopen_f(hdf5_fh, "source_bank", dset, hdf5_err) ! Set up pointer to data f_ptr = c_loc(source_bank(1)) diff --git a/src/state_point.F90 b/src/state_point.F90 index b053a382fa..0d8f4711a4 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -46,7 +46,7 @@ contains call write_message(1) ! Create statepoint file - call file_create(filename, 'serial', UNIT_STATE) + call file_create(filename, 'serial') if (master) then @@ -251,7 +251,7 @@ contains if (source_separate) then ! Close statepoint file - call file_close('serial', UNIT_STATE) + call file_close('serial') ! Set filename for source filename = trim(path_output) // 'source.' // & @@ -262,7 +262,7 @@ contains call write_message(1) ! Create statepoint file - call file_create(filename, 'parallel', UNIT_SOURCE) + call file_create(filename, 'parallel') end if @@ -271,15 +271,15 @@ contains ! Close file if (source_separate) then - call file_close('parallel', UNIT_SOURCE) + call file_close('parallel') else - call file_close('serial', UNIT_STATE) + call file_close('serial') end if else ! Close file if not in eigenvalue mode or no source writing - call file_close('serial', UNIT_STATE) + call file_close('serial') end if @@ -306,7 +306,7 @@ contains call write_message(1) ! Open file for reading - call file_open(path_state_point, 'serial', UNIT_STATE) + call file_open(path_state_point, 'serial') ! Read revision number for state point file and make sure it matches with ! current version @@ -526,7 +526,7 @@ contains if (source_separate) then ! Close statepoint file - call file_close('serial', UNIT_STATE) + call file_close('serial') ! Set filename for source filename = trim(path_output) // 'source.' // & @@ -537,7 +537,7 @@ contains call write_message(1) ! Create statepoint file - call file_open(filename, 'parallel', UNIT_SOURCE) + call file_open(filename, 'parallel') end if @@ -546,15 +546,15 @@ contains ! Close file if (source_separate) then - call file_close('parallel', UNIT_SOURCE) + call file_close('parallel') else - call file_close('serial', UNIT_STATE) + call file_close('serial') end if else ! Close file if not in eigenvalue mode - call file_close('serial', UNIT_STATE) + call file_close('serial') end if From 9f5f0de52a04968b27b7865e8b31a5028b05c944 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 14 May 2013 09:50:02 -0700 Subject: [PATCH 19/65] when running HDF5 w/ MPI source can be written to statepoint in parallel, a separate source file is no longer required --- src/hdf5_interface.F90 | 26 ++++++++++++++++++----- src/output_interface.F90 | 9 ++++---- src/state_point.F90 | 45 ++++++++++++++++++---------------------- 3 files changed, 46 insertions(+), 34 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 06cb66aefb..83f558bf76 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -55,13 +55,21 @@ contains ! HDF5_FILE_OPEN !=============================================================================== - subroutine hdf5_file_open(filename, file_id) + subroutine hdf5_file_open(filename, file_id, mode) character(MAX_FILE_LEN) :: filename + character(*) :: mode integer(HID_T) :: file_id + integer :: open_mode - ! Create the file - call h5fopen_f(trim(filename), H5F_ACC_RDONLY_F, file_id, hdf5_err) + ! Determine access type + open_mode = H5F_ACC_RDONLY_F + if (trim(mode) == 'rw') then + open_mode = H5F_ACC_RDWR_F + end if + + ! Open file + call h5fopen_f(trim(filename), open_mode, file_id, hdf5_err) end subroutine hdf5_file_open @@ -107,18 +115,26 @@ contains ! HDF5_PARALLEL_FILE_OPEN !=============================================================================== - subroutine hdf5_parallel_file_open(filename, file_id) + subroutine hdf5_parallel_file_open(filename, file_id, mode) character(MAX_FILE_LEN) :: filename + character(*) :: mode integer(HID_T) :: file_id integer(HID_T) :: plist_id + integer :: open_mode ! Setup file access property list with parallel I/O access call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) + ! Determine access type + open_mode = H5F_ACC_RDONLY_F + if (trim(mode) == 'rw') then + open_mode = H5F_ACC_RDWR_F + end if + ! Create the file collectively - call h5fopen_f(trim(filename), H5F_ACC_RDONLY_F, file_id, hdf5_err, & + call h5fopen_f(trim(filename), open_mode, file_id, hdf5_err, & access_prp = plist_id) ! Close the property list diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 1a7ddad88b..d29efff0fe 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -71,10 +71,11 @@ contains ! FILE_OPEN !=============================================================================== - subroutine file_open(filename, fh_str) + subroutine file_open(filename, fh_str, mode) character(*) :: filename character(*) :: fh_str + character(*) :: mode #ifdef HDF5 filename = trim(filename) // '.h5' @@ -85,12 +86,12 @@ contains #ifdef HDF5 # ifdef MPI if (trim(fh_str) == 'serial') then - call hdf5_file_open(filename, hdf5_fh) + if (master) call hdf5_file_open(filename, hdf5_fh, mode) else - call hdf5_parallel_file_open(filename, hdf5_fh) + call hdf5_parallel_file_open(filename, hdf5_fh, mode) endif # else - call hdf5_file_open(filename, hdf5_fh) + call hdf5_file_open(filename, hdf5_fh, mode) # endif #elif MPI call mpi_open_file(filename, mpi_fh) diff --git a/src/state_point.F90 b/src/state_point.F90 index 0d8f4711a4..5b57988f5a 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -241,13 +241,7 @@ contains ! Check for eigenvalue calculation if (run_mode == MODE_EIGENVALUE .and. source_write) then - ! Change file handles if source is separately written -#ifdef HDF5 -# ifdef MPI - source_separate = .true. -# endif -#endif - + ! Check for writing source out separately if (source_separate) then ! Close statepoint file @@ -264,17 +258,24 @@ contains ! Create statepoint file call file_create(filename, 'parallel') +#ifdef HDF5 +# ifdef MPI + else + ! Close HDF5 serial file and reopen in parallel + call file_close('serial') + filename = trim(path_output) // 'statepoint.' // & + trim(to_str(current_batch)) + call file_open(filename, 'parallel', 'rw') +# endif +#endif + end if ! Write out source call write_source_bank() - ! Close file - if (source_separate) then - call file_close('parallel') - else - call file_close('serial') - end if + ! Close file, all files in parallel mode + call file_close('parallel') ! even if no MPI, this will work for HDF5 else @@ -306,7 +307,7 @@ contains call write_message(1) ! Open file for reading - call file_open(path_state_point, 'serial') + call file_open(path_state_point, 'parallel', 'r') ! Read revision number for state point file and make sure it matches with ! current version @@ -516,17 +517,11 @@ contains ! Read source if in eigenvalue mode if (run_mode == MODE_EIGENVALUE .and. run_mode /= MODE_TALLIES) then - ! Change file handles if source is separately written -#ifdef HDF5 -# ifdef MPI - source_separate = .true. -# endif -#endif - + ! Check if source was written out separately if (source_separate) then ! Close statepoint file - call file_close('serial') + call file_close('parallel') ! Set filename for source filename = trim(path_output) // 'source.' // & @@ -537,7 +532,7 @@ contains call write_message(1) ! Create statepoint file - call file_open(filename, 'parallel') + call file_open(filename, 'parallel', 'r') end if @@ -548,13 +543,13 @@ contains if (source_separate) then call file_close('parallel') else - call file_close('serial') + call file_close('parallel') end if else ! Close file if not in eigenvalue mode - call file_close('serial') + call file_close('parallel') end if From 37bd204f97c3440d043e77dd9f397b82d064a1ef Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 14 May 2013 10:09:52 -0700 Subject: [PATCH 20/65] removed all dependencies from hdf5_interface --- src/DEPENDENCIES | 3 --- src/hdf5_interface.F90 | 9 ++++----- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index 1ef2e5cdb0..e16bda0139 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -173,9 +173,6 @@ global.o: source_header.o global.o: tally_header.o global.o: timer_header.o -hdf5_interface.o: constants.o -hdf5_interface.o: string.o - hdf5_summary.o: ace_header.o hdf5_summary.o: constants.o hdf5_summary.o: endf.o diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 83f558bf76..998142cf16 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -2,7 +2,6 @@ module hdf5_interface #ifdef HDF5 - use constants use hdf5 use h5lt use, intrinsic :: ISO_C_BINDING @@ -43,7 +42,7 @@ contains subroutine hdf5_file_create(filename, file_id) - character(MAX_FILE_LEN) :: filename + character(*) :: filename integer(HID_T) :: file_id ! Create the file @@ -57,7 +56,7 @@ contains subroutine hdf5_file_open(filename, file_id, mode) - character(MAX_FILE_LEN) :: filename + character(*) :: filename character(*) :: mode integer(HID_T) :: file_id integer :: open_mode @@ -94,7 +93,7 @@ contains subroutine hdf5_parallel_file_create(filename, file_id) - character(MAX_FILE_LEN) :: filename + character(*) :: filename integer(HID_T) :: file_id integer(HID_T) :: plist_id @@ -117,7 +116,7 @@ contains subroutine hdf5_parallel_file_open(filename, file_id, mode) - character(MAX_FILE_LEN) :: filename + character(*) :: filename character(*) :: mode integer(HID_T) :: file_id integer(HID_T) :: plist_id From 0704669e4f1ce04f8519a2bc20c0aa61bbc2b952 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 16 May 2013 09:33:19 -0400 Subject: [PATCH 21/65] added 2D and 3D hdf5 writing capability --- src/hdf5_interface.F90 | 106 ++++++++++++++++++++++++++++++- src/output_interface.F90 | 130 +++++++++++++++++++++++++++++++++++++-- 2 files changed, 230 insertions(+), 6 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 998142cf16..a3de2e9281 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -171,6 +171,7 @@ contains subroutine hdf5_close_group() + ! Close the group call h5gclose_f(temp_group, hdf5_err) end subroutine hdf5_close_group @@ -215,6 +216,50 @@ contains end subroutine hdf5_write_integer_1Darray +!=============================================================================== +! HDF5_WRITE_INTEGER_2DARRAY +!=============================================================================== + + subroutine hdf5_write_integer_2Darray(group, name, buffer, length) + + integer, intent(in) :: length(2) + integer(HID_T), intent(in) :: group + character(*), intent(in) :: name + integer, intent(in) :: buffer(length(1),length(2)) + + integer :: rank + integer(HSIZE_T) :: dims(2) + + rank = 2 + dims(2) = length(2) + + call h5ltmake_dataset_int_f(group, name, rank, dims, & + buffer, hdf5_err) + + end subroutine hdf5_write_integer_2Darray + +!=============================================================================== +! HDF5_WRITE_INTEGER_3DARRAY +!=============================================================================== + + subroutine hdf5_write_integer_3Darray(group, name, buffer, length) + + integer, intent(in) :: length(3) + integer(HID_T), intent(in) :: group + character(*), intent(in) :: name + integer, intent(in) :: buffer(length(1),length(2), length(3)) + + integer :: rank + integer(HSIZE_T) :: dims(3) + + rank = 3 + dims(3) = length(3) + + call h5ltmake_dataset_int_f(group, name, rank, dims, & + buffer, hdf5_err) + + end subroutine hdf5_write_integer_3Darray + !=============================================================================== ! HDF5_WRITE_LONG !=============================================================================== @@ -286,6 +331,50 @@ contains end subroutine hdf5_write_double_1Darray +!=============================================================================== +! HDF5_WRITE_DOUBLE_2DARRAY +!=============================================================================== + + subroutine hdf5_write_double_2Darray(group, name, buffer, length) + + integer, intent(in) :: length(2) + integer(HID_T), intent(in) :: group + character(*), intent(in) :: name + real(8), intent(in) :: buffer(length(1),length(2)) + + integer :: rank + integer(HSIZE_T) :: dims(2) + + rank = 2 + dims(2) = length(2) + + call h5ltmake_dataset_double_f(group, name, rank, dims, & + buffer, hdf5_err) + + end subroutine hdf5_write_double_2Darray + +!=============================================================================== +! HDF5_WRITE_DOUBLE_3DARRAY +!=============================================================================== + + subroutine hdf5_write_double_3Darray(group, name, buffer, length) + + integer, intent(in) :: length(3) + integer(HID_T), intent(in) :: group + character(*), intent(in) :: name + real(8), intent(in) :: buffer(length(1),length(2), length(3)) + + integer :: rank + integer(HSIZE_T) :: dims(3) + + rank = 3 + dims(3) = length(3) + + call h5ltmake_dataset_double_f(group, name, rank, dims, & + buffer, hdf5_err) + + end subroutine hdf5_write_double_3Darray + !=============================================================================== ! HDF5_WRITE_STRING !=============================================================================== @@ -299,7 +388,22 @@ contains call h5ltmake_dataset_string_f(group, name, buffer, hdf5_err) end subroutine hdf5_write_string - + +!=============================================================================== +! HDF5_WRITE_ATTRIBUTE_STRING +!=============================================================================== + + subroutine hdf5_write_attribute_string(group, var, attr_type, attr_str) + + integer(HID_T), intent(in) :: group + character(*), intent(in) :: var + character(*), intent(in) :: attr_type + character(*), intent(in) :: attr_str + + call h5ltset_attribute_string_f(group, var, attr_type, attr_str, hdf5_err) + + end subroutine hdf5_write_attribute_string + !=============================================================================== ! HDF5_READ_INTEGER !=============================================================================== diff --git a/src/output_interface.F90 b/src/output_interface.F90 index d29efff0fe..4761021d5e 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -17,8 +17,12 @@ module output_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_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 @@ -233,6 +237,53 @@ contains end subroutine read_double_1Darray +!=============================================================================== +! WRITE_DOUBLE_2DARRAY +!=============================================================================== + + subroutine write_double_2Darray(buffer, name, group, length) + + integer, intent(in) :: length(2) + real(8), intent(in) :: buffer(length(1),length(2)) + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_write_double_2Darray(temp_group, name, buffer, length) + if (present(group)) call hdf5_close_group() +#endif + + end subroutine write_double_2Darray + +!=============================================================================== +! WRITE_DOUBLE_3DARRAY +!=============================================================================== + + subroutine write_double_3Darray(buffer, name, group, length) + + integer, intent(in) :: length(3) + real(8), intent(in) :: buffer(length(1),length(2), & + length(3)) + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_write_double_3Darray(temp_group, name, buffer, length) + if (present(group)) call hdf5_close_group() +#endif + + end subroutine write_double_3Darray + !=============================================================================== ! WRITE_INTEGER !=============================================================================== @@ -339,6 +390,53 @@ contains end subroutine read_integer_1Darray +!=============================================================================== +! WRITE_INTEGER_2DARRAY +!=============================================================================== + + subroutine write_integer_2Darray(buffer, name, group, length) + + integer, intent(in) :: length(2) + integer, intent(in) :: buffer(length(1),length(2)) + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_write_integer_2Darray(temp_group, name, buffer, length) + if (present(group)) call hdf5_close_group() +#endif + + end subroutine write_integer_2Darray + +!=============================================================================== +! WRITE_DOUBLE_3DARRAY +!=============================================================================== + + subroutine write_integer_3Darray(buffer, name, group, length) + + integer, intent(in) :: length(3) + integer, intent(in) :: buffer(length(1),length(2), & + length(3)) + character(*), intent(in) :: name + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_write_integer_3Darray(temp_group, name, buffer, length) + if (present(group)) call hdf5_close_group() +#endif + + end subroutine write_integer_3Darray + !=============================================================================== ! WRITE_LONG !=============================================================================== @@ -457,6 +555,28 @@ contains end subroutine read_string +!=============================================================================== +! WRITE_ATTRIBUTE_STRING +!=============================================================================== + + subroutine write_attribute_string(var, attr_type, attr_str, group) + + character(*), intent(in) :: var + character(*), intent(in) :: attr_type + character(*), intent(in) :: attr_str + character(*), intent(in), optional :: group + +#ifdef HDF5 + if (present(group)) then + call hdf5_open_group(group) + else + temp_group = hdf5_fh + endif + call hdf5_write_attribute_string(temp_group, var, attr_type, attr_str) +#endif + + end subroutine write_attribute_string + !=============================================================================== ! WRITE_TALLY_RESULT !=============================================================================== @@ -466,7 +586,7 @@ contains character(*), intent(in), optional :: group character(*), intent(in) :: name integer, intent(in) :: n1, n2 - type(TallyResult), intent(in) :: buffer(n1, n2) + type(TallyResult), intent(in), target :: buffer(n1, n2) #ifdef HDF5 integer :: hdf5_err @@ -535,10 +655,10 @@ contains subroutine read_tally_result(buffer, name, group, n1, n2) - character(*), intent(in), optional :: group - character(*), intent(in) :: name - integer, intent(in) :: n1, n2 - type(TallyResult), intent(inout) :: buffer(n1, n2) + character(*), intent(in), optional :: group + character(*), intent(in) :: name + integer, intent(in) :: n1, n2 + type(TallyResult), intent(inout), target :: buffer(n1, n2) #ifdef HDF5 integer :: hdf5_err From 628874256d422d493eb711fa45af3c27c7d85670 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 16 May 2013 09:33:56 -0400 Subject: [PATCH 22/65] hdf5 summary file write is converted up through geometry parameters --- src/hdf5_summary.F90 | 269 ++++++++++++++++++++----------------------- 1 file changed, 126 insertions(+), 143 deletions(-) diff --git a/src/hdf5_summary.F90 b/src/hdf5_summary.F90 index b4623e1a72..552aca6625 100644 --- a/src/hdf5_summary.F90 +++ b/src/hdf5_summary.F90 @@ -9,6 +9,7 @@ module hdf5_summary use global use hdf5_interface use material_header, only: Material + use output_interface use output, only: time_stamp use string, only: to_str use tally_header, only: TallyObject @@ -21,37 +22,37 @@ contains subroutine hdf5_write_summary() - character(MAX_FILE_LEN) :: filename = "summary.h5" + character(MAX_FILE_LEN) :: filename = "summary" ! Create a new file using default properties. - call h5fcreate_f(filename, H5F_ACC_TRUNC_F, hdf5_output_file, hdf5_err) + call file_create(filename, "serial") ! Write header information call hdf5_write_header() ! Write eigenvalue information if (run_mode == MODE_EIGENVALUE) then - ! Need to write integer(8)'s using double instead since there is no H5LT - ! call for making a dataset of type long - call hdf5_write_double(hdf5_output_file, "n_particles", real(n_particles,8)) + + ! Write number of particles + call write_data(n_particles, "n_particles") ! Use H5LT interface to write n_batches, n_inactive, and n_active - call hdf5_write_integer(hdf5_output_file, "n_batches", n_batches) - call hdf5_write_integer(hdf5_output_file, "n_inactive", n_inactive) - call hdf5_write_integer(hdf5_output_file, "n_active", n_active) - call hdf5_write_integer(hdf5_output_file, "gen_per_batch", gen_per_batch) + 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") ! Add description of each variable - call h5ltset_attribute_string_f(hdf5_output_file, "n_particles", & - "description", "Number of particles per generation", hdf5_err) - call h5ltset_attribute_string_f(hdf5_output_file, "n_batches", & - "description", "Total number of batches", hdf5_err) - call h5ltset_attribute_string_f(hdf5_output_file, "n_inactive", & - "description", "Number of inactive batches", hdf5_err) - call h5ltset_attribute_string_f(hdf5_output_file, "n_active", & - "description", "Number of active batches", hdf5_err) - call h5ltset_attribute_string_f(hdf5_output_file, "gen_per_batch", & - "description", "Number of generations per batch", hdf5_err) + call write_attribute_string("n_particles", & + "description", "Number of particles per generation") + call write_attribute_string("n_batches", & + "description", "Total number of batches") + call write_attribute_string("n_inactive", & + "description", "Number of inactive batches") + call write_attribute_string("n_active", & + "description", "Number of active batches") + call write_attribute_string("gen_per_batch", & + "description", "Number of generations per batch") end if call hdf5_write_geometry() @@ -73,18 +74,17 @@ contains subroutine hdf5_write_header() ! Write version information - call hdf5_write_integer(hdf5_output_file, "version_major", VERSION_MAJOR) - call hdf5_write_integer(hdf5_output_file, "version_minor", VERSION_MINOR) - call hdf5_write_integer(hdf5_output_file, "version_release", VERSION_RELEASE) + call write_data(VERSION_MAJOR, "version_major") + call write_data(VERSION_MINOR, "version_minor") + call write_data(VERSION_RELEASE, "version_release") ! Write current date and time - call h5ltmake_dataset_string_f(hdf5_output_file, "date_and_time", & - time_stamp(), hdf5_err) + call write_data(time_stamp(), "date_and_time") ! Write MPI information - call hdf5_write_integer(hdf5_output_file, "n_procs", n_procs) - call h5ltset_attribute_string_f(hdf5_output_file, "n_procs", & - "description", "Number of MPI processes", hdf5_err) + call write_data(n_procs, "n_procs") + call write_attribute_string("n_procs", "description", & + "Number of MPI processes") end subroutine hdf5_write_header @@ -110,203 +110,193 @@ contains type(Universe), pointer :: u => null() type(Lattice), pointer :: lat => null() - ! Create group for geometry - call h5gcreate_f(hdf5_output_file, "/geometry", geometry_group, hdf5_err) - ! Use H5LT interface to write number of geometry objects - call hdf5_write_integer(geometry_group, "n_cells", n_cells) - call hdf5_write_integer(geometry_group, "n_surfaces", n_surfaces) - call hdf5_write_integer(geometry_group, "n_universes", n_universes) - call hdf5_write_integer(geometry_group, "n_lattices", n_lattices) + 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") ! ========================================================================== ! WRITE INFORMATION ON CELLS - call h5gcreate_f(geometry_group, "cells", cell_group, hdf5_err) + ! Create a cell group (nothing directly written in this group) then close + call hdf5_open_group("geometry/cells") + call hdf5_close_group() ! Write information on each cell - do i = 1, n_cells + CELL_LOOP: do i = 1, n_cells c => cells(i) - ! Create group for i-th cell - call h5gcreate_f(cell_group, "cell " // trim(to_str(c % id)), & - temp_group, hdf5_err) - ! Write universe for this cell - call hdf5_write_integer(temp_group, "universe", & - universes(c % universe) % id) + call 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 h5ltmake_dataset_string_f(temp_group, "fill_type", "normal", & - hdf5_err) + call write_data("normal", "fill_type", & + group="geometry/cells/cell " // trim(to_str(c % id))) if (c % material == MATERIAL_VOID) then - call hdf5_write_integer(temp_group, "material", -1) + call write_data(-1, "material", & + group="geometry/cells/cell " // trim(to_str(c % id))) else - call hdf5_write_integer(temp_group, "material", & - materials(c % material) % id) + call write_data(materials(c % material) % id, "material", & + group="geometry/cells/cell " // trim(to_str(c % id))) end if case (CELL_FILL) - call h5ltmake_dataset_string_f(temp_group, "fill_type", "universe", & - hdf5_err) - call hdf5_write_integer(temp_group, "material", & - universes(c % fill) % id) + call write_data("universe", "fill_type", & + group="geometry/cells/cell " // trim(to_str(c % id))) + call write_data(universes(c % fill) % id, "material", & + group="geometry/cells/cell " // trim(to_str(c % id))) case (CELL_LATTICE) - call h5ltmake_dataset_string_f(temp_group, "fill_type", "lattice", & - hdf5_err) - call hdf5_write_integer(temp_group, "lattice", & - lattices(c % fill) % id) + call write_data("lattice", "fill_type", & + group="geometry/cells/cell " // trim(to_str(c % id))) + call 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 - dims(1) = c % n_surfaces - call h5ltmake_dataset_int_f(temp_group, "surfaces", 1, & - dims, c % surfaces, hdf5_err) + call write_data(c % surfaces, "surfaces", length= c % n_surfaces, & + group="geometry/cells/cell " // trim(to_str(c % id))) end if - ! Close group for i-th cell - call h5gclose_f(temp_group, hdf5_err) - end do - - call h5gclose_f(cell_group, hdf5_err) + end do CELL_LOOP ! ========================================================================== ! WRITE INFORMATION ON SURFACES - call h5gcreate_f(geometry_group, "surfaces", surface_group, hdf5_err) + ! Create surfaces group (nothing directly written here) then close + call hdf5_open_group("geometry/surfaces") + call hdf5_close_group() ! Write information on each surface - do i = 1, n_surfaces + SURFACE_LOOP: do i = 1, n_surfaces s => surfaces(i) - ! Create group for i-th surface - call h5gcreate_f(surface_group, "surface " // trim(to_str(s % id)), & - temp_group, hdf5_err) - ! Write surface type select case (s % type) case (SURF_PX) - call h5ltmake_dataset_string_f(temp_group, "type", "X Plane", hdf5_err) + call write_data("X Plane", "type", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_PY) - call h5ltmake_dataset_string_f(temp_group, "type", "Y Plane", hdf5_err) + call write_data("Y Plane", "type", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_PZ) - call h5ltmake_dataset_string_f(temp_group, "type", "Z Plane", hdf5_err) + call write_data("Z Plane", "type", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_PLANE) - call h5ltmake_dataset_string_f(temp_group, "type", "Plane", hdf5_err) + call write_data("Plane", "type", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_CYL_X) - call h5ltmake_dataset_string_f(temp_group, "type", "X Cylinder", hdf5_err) + call write_data("X Cylinder", "type", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_CYL_Y) - call h5ltmake_dataset_string_f(temp_group, "type", "Y Cylinder", hdf5_err) + call write_data("Y Cylinder", "type", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_CYL_Z) - call h5ltmake_dataset_string_f(temp_group, "type", "Z Cylinder", hdf5_err) + call write_data("Z Cylinder", "type", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_SPHERE) - call h5ltmake_dataset_string_f(temp_group, "type", "Sphere", hdf5_err) + call write_data("Sphere", "type", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_CONE_X) - call h5ltmake_dataset_string_f(temp_group, "type", "X Cone", hdf5_err) + call write_data("X Cone", "type", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_CONE_Y) - call h5ltmake_dataset_string_f(temp_group, "type", "Y Cone", hdf5_err) + call write_data("Y Cone", "type", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (SURF_CONE_Z) - call h5ltmake_dataset_string_f(temp_group, "type", "Z Cone", hdf5_err) + call write_data("Z Cone", "type", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) end select ! Write coefficients for surface - dims(1) = size(s % coeffs) - call h5ltmake_dataset_double_f(temp_group, "coefficients", 1, dims, & - s % coeffs, hdf5_err) + call 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 - dims(1) = size(s % neighbor_pos) - call h5ltmake_dataset_int_f(temp_group, "neighbors_positive", 1, dims, & - s % neighbor_pos, hdf5_err) + call 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 - dims(1) = size(s % neighbor_neg) - call h5ltmake_dataset_int_f(temp_group, "neighbors_negative", 1, dims, & - s % neighbor_neg, hdf5_err) + call write_data(s % neighbor_neg, "neighbors_negative", & + length=size(s % neighbor_neg), & + group="geometry/surfaces/surface " // trim(to_str(s % id))) end if ! Write boundary condition select case (s % bc) case (BC_TRANSMIT) - call h5ltmake_dataset_string_f(temp_group, "boundary_condition", & - "transmission", hdf5_err) + call write_data("transmission", "boundary_condition", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (BC_VACUUM) - call h5ltmake_dataset_string_f(temp_group, "boundary_condition", & - "vacuum", hdf5_err) + call write_data("vacuum", "boundary_condition", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (BC_REFLECT) - call h5ltmake_dataset_string_f(temp_group, "boundary_condition", & - "reflective", hdf5_err) + call write_data("reflective", "boundary_condition", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) case (BC_PERIODIC) - call h5ltmake_dataset_string_f(temp_group, "boundary_condition", & - "periodic", hdf5_err) + call write_data("periodic", "boundary_condition", & + group="geometry/surfaces/surface " // trim(to_str(s % id))) end select - ! Close group for i-th surface - call h5gclose_f(temp_group, hdf5_err) - end do - - call h5gclose_f(surface_group, hdf5_err) + end do SURFACE_LOOP ! ========================================================================== ! WRITE INFORMATION ON UNIVERSES - call h5gcreate_f(geometry_group, "universes", universe_group, hdf5_err) + ! Create universes group (nothing directly written here) then close + call hdf5_open_group("geometry/universes") + call hdf5_close_group() ! Write information on each universe - do i = 1, n_universes + UNIVERSE_LOOP: do i = 1, n_universes u => universes(i) - ! Create group for i-th universe - call h5gcreate_f(universe_group, "universe " // trim(to_str(u % id)), & - temp_group, hdf5_err) - ! Write list of cells in this universe if (u % n_cells > 0) then - dims(1) = u % n_cells - call h5ltmake_dataset_int_f(temp_group, "cells", 1, dims, & - u % cells, hdf5_err) + call write_data(u % cells, "cells", length=u % n_cells, & + group="geometry/universes/universe " // trim(to_str(u % id))) end if - ! Close group for i-th universe - call h5gclose_f(temp_group, hdf5_err) - end do - - call h5gclose_f(universe_group, hdf5_err) + end do UNIVERSE_LOOP ! ========================================================================== ! WRITE INFORMATION ON LATTICES - call h5gcreate_f(geometry_group, "lattices", lattice_group, hdf5_err) + ! Create lattices group (nothing directly written here) then close + call hdf5_open_group("geometry/lattices") + call hdf5_close_group() ! Write information on each lattice - do i = 1, n_lattices + LATTICE_LOOP: do i = 1, n_lattices lat => lattices(i) - ! Create group for i-th lattice - call h5gcreate_f(lattice_group, "lattice " // trim(to_str(lat % id)), & - temp_group, hdf5_err) - ! Write lattice type select case(lat % type) case (LATTICE_RECT) - call h5ltmake_dataset_string_f(temp_group, "type", "rectangular", hdf5_err) + call write_data("rectangular", "type", & + group="geometry/lattices/lattice " // trim(to_str(lat % id))) case (LATTICE_HEX) - call h5ltmake_dataset_string_f(temp_group, "type", "hexagonal", hdf5_err) + call 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 - dims(1) = lat % n_dimension - call h5ltmake_dataset_int_f(temp_group, "dimension", 1, dims, & - lat % dimension, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "lower_left", 1, dims, & - lat % lower_left, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "width", 1, dims, & - lat % width, hdf5_err) + call 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", & + length=lat % n_dimension, & + group="geometry/lattices/lattice " // trim(to_str(lat % id))) + call write_data(lat % width, "width", & + length=lat % n_dimension, & + group="geometry/lattices/lattice " // trim(to_str(lat % id))) ! Determine dimensions of lattice n_x = lat % dimension(1) @@ -326,20 +316,13 @@ contains end do end do end do - dims3 = (/ n_x, n_y, n_z /) - call h5ltmake_dataset_int_f(temp_group, "universes", 3, dims3, & - lattice_universes, hdf5_err) + call write_data(lattice_universes, "universes", & + length=(/n_x, n_y, n_z/), & + group="geometry/lattices/lattice " // trim(to_str(lat % id))) deallocate(lattice_universes) - ! Close group for i-th lattice - call h5gclose_f(temp_group, hdf5_err) - end do - - call h5gclose_f(lattice_group, hdf5_err) - - ! Close geometry group - call h5gclose_f(geometry_group, hdf5_err) - + end do LATTICE_LOOP +stop end subroutine hdf5_write_geometry !=============================================================================== From c04c07800ce094d482c64c1a57a61715df1ff33d Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 16 May 2013 10:33:14 -0400 Subject: [PATCH 23/65] fixed dims when writing 2D and 3D hdf5 arrays --- src/hdf5_interface.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index a3de2e9281..678a5b7cb3 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -231,7 +231,7 @@ contains integer(HSIZE_T) :: dims(2) rank = 2 - dims(2) = length(2) + dims = length call h5ltmake_dataset_int_f(group, name, rank, dims, & buffer, hdf5_err) @@ -253,7 +253,7 @@ contains integer(HSIZE_T) :: dims(3) rank = 3 - dims(3) = length(3) + dims = length call h5ltmake_dataset_int_f(group, name, rank, dims, & buffer, hdf5_err) @@ -346,7 +346,7 @@ contains integer(HSIZE_T) :: dims(2) rank = 2 - dims(2) = length(2) + dims = length call h5ltmake_dataset_double_f(group, name, rank, dims, & buffer, hdf5_err) @@ -368,7 +368,7 @@ contains integer(HSIZE_T) :: dims(3) rank = 3 - dims(3) = length(3) + dims = length call h5ltmake_dataset_double_f(group, name, rank, dims, & buffer, hdf5_err) From dd64e78c4a4c512207727d2de2cd3d6bbd70bb5a Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 16 May 2013 15:48:16 -0400 Subject: [PATCH 24/65] changed write commands over to new output interface --- src/hdf5_summary.F90 | 410 ++++++++++++++++++++----------------------- 1 file changed, 195 insertions(+), 215 deletions(-) diff --git a/src/hdf5_summary.F90 b/src/hdf5_summary.F90 index 552aca6625..1c8d15e585 100644 --- a/src/hdf5_summary.F90 +++ b/src/hdf5_summary.F90 @@ -7,8 +7,8 @@ module hdf5_summary use endf, only: reaction_name use geometry_header, only: Cell, Surface, Universe, Lattice use global - use hdf5_interface use material_header, only: Material + use mesh_header, only: StructuredMesh use output_interface use output, only: time_stamp use string, only: to_str @@ -63,7 +63,7 @@ contains end if ! Terminate access to the file. - call h5fclose_f(hdf5_output_file, hdf5_err) + call file_close("serial") end subroutine hdf5_write_summary @@ -96,14 +96,6 @@ contains integer :: i, j, k, m integer :: n_x, n_y, n_z - integer(HSIZE_T) :: dims(1) - integer(HSIZE_T) :: dims3(3) - integer(HID_T) :: geometry_group - integer(HID_T) :: cell_group - integer(HID_T) :: surface_group - integer(HID_T) :: universe_group - integer(HID_T) :: lattice_group - integer(HID_T) :: temp_group integer, allocatable :: lattice_universes(:,:,:) type(Cell), pointer :: c => null() type(Surface), pointer :: s => null() @@ -322,7 +314,7 @@ contains deallocate(lattice_universes) end do LATTICE_LOOP -stop + end subroutine hdf5_write_geometry !=============================================================================== @@ -333,30 +325,21 @@ stop integer :: i integer :: j - integer(HSIZE_T) :: dims(1) - integer(HID_T) :: materials_group - integer(HID_T) :: temp_group integer, allocatable :: zaids(:) type(Material), pointer :: m => null() - ! Create group for materials - call h5gcreate_f(hdf5_output_file, "/materials", materials_group, hdf5_err) - ! Use H5LT interface to write number of materials - call hdf5_write_integer(materials_group, "n_materials", n_materials) + call write_data(n_materials, "n_materials", group="materials") ! Write information on each material do i = 1, n_materials m => materials(i) - ! Create group for i-th universe - call h5gcreate_f(materials_group, "material " // trim(to_str(m % id)), & - temp_group, hdf5_err) - ! Write atom density with units - call hdf5_write_double(temp_group, "atom_density", m % density) - call h5ltset_attribute_string_f(temp_group, "atom_density", & - "units", "atom/barn-cm", hdf5_err) + call write_data(m % density, "atom_density", & + group="materials/material " // trim(to_str(m % id))) + call 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 allocate(zaids(m % n_nuclides)) @@ -365,33 +348,29 @@ stop end do ! Write temporary array to 'nuclides' - dims(1) = m % n_nuclides - call h5ltmake_dataset_int_f(temp_group, "nuclides", 1, & - dims, zaids, hdf5_err) + call 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 h5ltmake_dataset_double_f(temp_group, "nuclide_densities", 1, & - dims, m % atom_density, hdf5_err) + call 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 - dims(1) = m % n_sab - call h5ltmake_dataset_int_f(temp_group, "i_sab_nuclides", 1, & - dims, m % i_sab_nuclides, hdf5_err) - call h5ltmake_dataset_int_f(temp_group, "i_sab_tables", 1, & - dims, m % i_sab_tables, hdf5_err) + call 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", & + length=m % n_sab, & + group="materials/material " // trim(to_str(m % id))) end if - ! Close group for i-th material - call h5gclose_f(temp_group, hdf5_err) end do - ! Close materials group - call h5gclose_f(materials_group, hdf5_err) - end subroutine hdf5_write_materials !=============================================================================== @@ -401,124 +380,123 @@ stop subroutine hdf5_write_tallies() integer :: i, j - integer(HSIZE_T) :: dims(1) - integer(HID_T) :: tallies_group - integer(HID_T) :: temp_group - integer(HID_T) :: filter_group ! group for i-th filter integer, allocatable :: temp_array(:) ! nuclide bin array + type(StructuredMesh), pointer :: m => null() type(TallyObject), pointer :: t => null() - ! Create group for tallies - call h5gcreate_f(hdf5_output_file, "tallies", tallies_group, hdf5_err) - ! Write total number of meshes - call hdf5_write_integer(tallies_group, "n_meshes", n_meshes) + call write_data(n_meshes, "n_meshes", group="tallies") ! Write information for meshes MESH_LOOP: do i = 1, n_meshes - ! Create temporary group for each mesh - call h5gcreate_f(tallies_group, "mesh" // to_str(i), & - temp_group, hdf5_err) + m => meshes(i) ! Write type and number of dimensions - call hdf5_write_integer(temp_group, "type", meshes(i) % type) - call hdf5_write_integer(temp_group, "n_dimension", & - meshes(i) % n_dimension) + call write_data(m % type, "type", & + group="tallies/mesh " // trim(to_str(m % id))) + + call write_data(m % n_dimension, "n_dimension", & + group="tallies/mesh " // trim(to_str(m % id))) ! Write mesh information - dims(1) = meshes(i) % n_dimension - call h5ltmake_dataset_int_f(temp_group, "dimension", 1, & - dims, meshes(i) % dimension, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "lower_left", 1, & - dims, meshes(i) % lower_left, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "upper_right", 1, & - dims, meshes(i) % upper_right, hdf5_err) - call h5ltmake_dataset_double_f(temp_group, "width", 1, & - dims, meshes(i) % width, hdf5_err) + call 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", & + length=m % n_dimension, & + group="tallies/mesh " // trim(to_str(m % id))) + call 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", & + length=m % n_dimension, & + group="tallies/mesh " // trim(to_str(m % id))) - ! Close temporary group for mesh - call h5gclose_f(temp_group, hdf5_err) end do MESH_LOOP ! Write number of tallies - call hdf5_write_integer(tallies_group, "n_tallies", n_tallies) + call write_data(n_tallies, "n_tallies", group="tallies") TALLY_METADATA: do i = 1, n_tallies ! Get pointer to tally t => tallies(i) - ! Create group for this tally - call h5gcreate_f(tallies_group, "tally" // to_str(i), & - temp_group, hdf5_err) - ! Write size of each tally - call hdf5_write_integer(temp_group, "total_score_bins", & - t % total_score_bins) - call hdf5_write_integer(temp_group, "total_filter_bins", & - t % total_filter_bins) + call 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", & + group="tallies/tally " // trim(to_str(t % id))) ! Write number of filters - call hdf5_write_integer(temp_group, "n_filters", t % n_filters) + call write_data(t % n_filters, "n_filters", & + group="tallies/tally " // trim(to_str(t % id))) FILTER_LOOP: do j = 1, t % n_filters - ! Create filter group - call h5gcreate_f(temp_group, "filter" // to_str(j), filter_group, & - hdf5_err) - ! Write type of filter - call hdf5_write_integer(filter_group, "type", t % filters(j) % type) + call 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 hdf5_write_integer(filter_group, "n_bins", t % filters(j) % n_bins) + call 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 - dims(1) = size(t % filters(j) % real_bins) - call h5ltmake_dataset_double_f(filter_group, "bins", 1, & - dims, t % filters(j) % real_bins, hdf5_err) + call 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 - dims(1) = size(t % filters(j) % int_bins) - call h5ltmake_dataset_int_f(filter_group, "bins", 1, & - dims, t % filters(j) % int_bins, hdf5_err) + call 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))) end if ! Write name of type select case (t % filters(j) % type) case(FILTER_UNIVERSE) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "universe", hdf5_err) + call write_data("universe", "type_name", & + group="tallies/tally " // trim(to_str(t % id)) & + // "/filter " // trim(to_str(j))) case(FILTER_MATERIAL) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "material", hdf5_err) + call write_data("material", "type_name", & + group="tallies/tally " // trim(to_str(t % id)) & + // "/filter " // trim(to_str(j))) case(FILTER_CELL) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "cell", hdf5_err) + call write_data("cell", "type_name", & + group="tallies/tally " // trim(to_str(t % id)) & + // "/filter " // trim(to_str(j))) case(FILTER_CELLBORN) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "cellborn", hdf5_err) + call write_data("cellborn", "type_name", & + group="tallies/tally " // trim(to_str(t % id)) & + // "/filter " // trim(to_str(j))) case(FILTER_SURFACE) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "surface", hdf5_err) + call write_data("surface", "type_name", & + group="tallies/tally " // trim(to_str(t % id)) & + // "/filter " // trim(to_str(j))) case(FILTER_MESH) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "mesh", hdf5_err) + call write_data("mesh", "type_name", & + group="tallies/tally " // trim(to_str(t % id)) & + // "/filter " // trim(to_str(j))) case(FILTER_ENERGYIN) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "energy", hdf5_err) + call write_data("energy", "type_name", & + group="tallies/tally " // trim(to_str(t % id)) & + // "/filter " // trim(to_str(j))) case(FILTER_ENERGYOUT) - call h5ltmake_dataset_string_f(filter_group, "type_name", & - "energyout", hdf5_err) + call write_data("energyout", "type_name", & + group="tallies/tally " // trim(to_str(t % id)) & + // "/filter " // trim(to_str(j))) end select - ! Close group for this filter - call h5gclose_f(filter_group, hdf5_err) end do FILTER_LOOP ! Write number of nuclide bins - call hdf5_write_integer(temp_group, "n_nuclide_bins", & - t % n_nuclide_bins) - + call write_data(t % n_nuclide_bins, "n_nuclide_bins", & + group="tallies/tally " // trim(to_str(t % id))) ! Create temporary array for nuclide bins allocate(temp_array(t % n_nuclide_bins)) @@ -531,25 +509,18 @@ stop end do NUCLIDE_LOOP ! Write and deallocate nuclide bins - dims(1) = t % n_nuclide_bins - call h5ltmake_dataset_int_f(temp_group, "nuclide_bins", 1, & - dims, temp_array, hdf5_err) + call 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 hdf5_write_integer(temp_group, "n_score_bins", & - t % n_score_bins) - dims(1) = t % n_score_bins - call h5ltmake_dataset_int_f(temp_group, "score_bins", 1, & - dims, t % score_bins, hdf5_err) + call 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, & + group="tallies/tally " // trim(to_str(t % id))) - ! Close tally group - call h5gclose_f(temp_group, hdf5_err) end do TALLY_METADATA - ! Close tallies group - call h5gclose_f(tallies_group, hdf5_err) - end subroutine hdf5_write_tallies !=============================================================================== @@ -563,47 +534,45 @@ stop integer :: size_xs integer :: size_angle integer :: size_energy - integer(HID_T) :: group - integer(HID_T) :: nuclide_group - integer(HID_T) :: reactions_group - integer(HID_T) :: rxn_group type(Nuclide), pointer :: nuc => null() type(Reaction), pointer :: rxn => null() type(UrrData), pointer :: urr => null() - ! Create group for nuclides - call h5gcreate_f(hdf5_output_file, "/nuclides", group, hdf5_err) - ! Use H5LT interface to write number of nuclides - call hdf5_write_integer(group, "n_nuclides", n_nuclides_total) + call write_data(n_nuclides_total, "n_nuclides", group="nuclides") ! Write information on each nuclide - do i = 1, n_nuclides_total + NUCLIDE_LOOP: do i = 1, n_nuclides_total nuc => nuclides(i) ! Determine size of cross-sections size_xs = (5 + nuc % n_reaction) * nuc % n_grid * 8 size_total = size_xs - ! Create group for i-th nuclide - call h5gcreate_f(group, trim(nuc % name), nuclide_group, hdf5_err) - ! Write some basic attributes - call hdf5_write_integer(nuclide_group, "zaid", nuc % zaid) - call hdf5_write_double(nuclide_group, "awr", nuc % awr) - call hdf5_write_double(nuclide_group, "kT", nuc % kT) - call hdf5_write_integer(nuclide_group, "n_grid", nuc % n_grid) - call hdf5_write_integer(nuclide_group, "n_reactions", nuc % n_reaction) - call hdf5_write_integer(nuclide_group, "n_fission", nuc % n_fission) - call hdf5_write_integer(nuclide_group, "size_xs", size_xs) + call write_data(nuc % zaid, "zaid", & + group="nuclides/" // trim(nuc % name)) + call write_data(nuc % awr, "awr", & + group="nuclides/" // trim(nuc % name)) + call write_data(nuc % kT, "kT", & + group="nuclides/" // trim(nuc % name)) + call write_data(nuc % n_grid, "n_grid", & + group="nuclides/" // trim(nuc % name)) + call write_data(nuc % n_reaction, "n_reactions", & + group="nuclides/" // trim(nuc % name)) + call write_data(nuc % n_fission, "n_fission", & + group="nuclides/" // trim(nuc % name)) + call write_data(size_xs, "size_xs", & + group="nuclides/" // trim(nuc % name)) ! ======================================================================= ! WRITE INFORMATION ON EACH REACTION - ! Create overall group - call h5gcreate_f(nuclide_group, "reactions", reactions_group, hdf5_err) + ! Create overall group for reactions and close it + call hdf5_open_group("nuclides/" // trim(nuc % name) // "/reactions") + call hdf5_close_group() - do j = 1, nuc % n_reaction + RXN_LOOP: do j = 1, nuc % n_reaction ! Information on each reaction rxn => nuc % reactions(j) @@ -621,49 +590,53 @@ stop size_energy = 0 end if - ! Create reaction group - call h5gcreate_f(reactions_group, reaction_name(rxn % MT), & - rxn_group, hdf5_err) - ! Write information on reaction - call hdf5_write_double(rxn_group, "Q_value", rxn % Q_value) - call hdf5_write_integer(rxn_group, "multiplicity", rxn % multiplicity) - call hdf5_write_integer(rxn_group, "threshold", rxn % threshold) - call hdf5_write_integer(rxn_group, "size_angle", size_angle) - call hdf5_write_integer(rxn_group, "size_energy", size_energy) - - call h5gclose_f(rxn_group, hdf5_err) + call write_data(rxn % Q_value, "Q_value", & + group="nuclides/" // trim(nuc % name) // "/reactions/" // & + trim(reaction_name(rxn % MT))) + call write_data(rxn % multiplicity, "multiplicity", & + group="nuclides/" // trim(nuc % name) // "/reactions/" // & + trim(reaction_name(rxn % MT))) + call write_data(rxn % threshold, "threshold", & + group="nuclides/" // trim(nuc % name) // "/reactions/" // & + trim(reaction_name(rxn % MT))) + call write_data(size_angle, "size_angle", & + group="nuclides/" // trim(nuc % name) // "/reactions/" // & + trim(reaction_name(rxn % MT))) + call write_data(size_energy, "size_energy", & + group="nuclides/" // trim(nuc % name) // "/reactions/" // & + trim(reaction_name(rxn % MT))) ! Accumulate data size size_total = size_total + size_angle + size_energy - end do - - ! Close overall group for reactions - call h5gclose_f(reactions_group, hdf5_err) + end do RXN_LOOP ! ======================================================================= ! WRITE INFORMATION ON URR PROBABILITY TABLES if (nuc % urr_present) then urr => nuc % urr_data - call hdf5_write_integer(nuclide_group, "urr_n_energy", urr % n_energy) - call hdf5_write_integer(nuclide_group, "urr_n_prob", urr % n_prob) - call hdf5_write_integer(nuclide_group, "urr_interp", urr % interp) - call hdf5_write_integer(nuclide_group, "urr_inelastic", urr % inelastic_flag) - call hdf5_write_integer(nuclide_group, "urr_absorption", urr % absorption_flag) - call hdf5_write_double(nuclide_group, "urr_min_E", urr % energy(1)) - call hdf5_write_double(nuclide_group, "urr_max_E", urr % energy(urr % n_energy)) + call write_data(urr % n_energy, "urr_n_energy", & + group="nuclides/" // trim(nuc % name)) + call write_data(urr % n_prob, "urr_n_prob", & + group="nuclides/" // trim(nuc % name)) + call write_data(urr % interp, "urr_interp", & + group="nuclides/" // trim(nuc % name)) + call write_data(urr % inelastic_flag, "urr_inelastic", & + group="nuclides/" // trim(nuc % name)) + call write_data(urr % absorption_flag, "urr_absorption", & + group="nuclides/" // trim(nuc % name)) + call write_data(urr % energy(1), "urr_min_E", & + group="nuclides/" // trim(nuc % name)) + call write_data(urr % energy(urr % n_energy), "urr_max_E", & + group="nuclides/" // trim(nuc % name)) end if ! Write total memory used - call hdf5_write_integer(nuclide_group, "size_total", size_total) + call write_data(size_total, "size_total", & + group="nuclides/" // trim(nuc % name)) - ! Close group for i-th nuclide - call h5gclose_f(nuclide_group, hdf5_err) - end do - - ! Close group for nuclides - call h5gclose_f(group, hdf5_err) + end do NUCLIDE_LOOP end subroutine hdf5_write_nuclides @@ -677,57 +650,64 @@ stop integer(8) :: total_particles real(8) :: speed - ! Create group for timing - call h5gcreate_f(hdf5_output_file, "/timing", timing_group, hdf5_err) - ! Write timing data - call hdf5_write_double(timing_group, "time_initialize", time_initialize % elapsed) - call hdf5_write_double(timing_group, "time_read_xs", time_read_xs % elapsed) - call hdf5_write_double(timing_group, "time_unionize", time_unionize % elapsed) - call hdf5_write_double(timing_group, "time_transport", time_transport % elapsed) - call hdf5_write_double(timing_group, "time_bank", time_bank % elapsed) - call hdf5_write_double(timing_group, "time_bank_sample", time_bank_sample % elapsed) - call hdf5_write_double(timing_group, "time_bank_sendrecv", time_bank_sendrecv % elapsed) - call hdf5_write_double(timing_group, "time_tallies", time_tallies % elapsed) - call hdf5_write_double(timing_group, "time_inactive", time_inactive % elapsed) - call hdf5_write_double(timing_group, "time_active", time_active % elapsed) - call hdf5_write_double(timing_group, "time_finalize", time_finalize % elapsed) - call hdf5_write_double(timing_group, "time_total", time_total % elapsed) + call write_data(time_initialize % elapsed, "time_initialize", & + group="timing") + call write_data(time_read_xs % elapsed, "time_read_xs", & + group="timing") + call write_data(time_unionize % elapsed, "time_unionize", & + group="timing") + call write_data(time_transport % elapsed, "time_transport", & + group="timing") + call write_data(time_bank % elapsed, "time_bank", & + group="timing") + call write_data(time_bank_sample % elapsed, "time_bank_sample", & + group="timing") + call write_data(time_bank_sendrecv % elapsed, "time_bank_sendrecv", & + group="timing") + call write_data(time_tallies % elapsed, "time_tallies", & + group="timing") + call write_data(time_inactive % elapsed, "time_inactive", & + group="timing") + call write_data(time_active % elapsed, "time_active", & + group="timing") + call write_data(time_finalize % elapsed, "time_finalize", & + group="timing") + call write_data(time_total % elapsed, "time_total", & + group="timing") ! Add descriptions to timing data - call h5ltset_attribute_string_f(timing_group, "time_initialize", & - "description", "Total time elapsed for initialization (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_read_xs", & - "description", "Time reading cross-section libraries (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_unionize", & - "description", "Time unionizing energy grid (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_transport", & - "description", "Time in transport only (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_bank", & - "description", "Total time synchronizing fission bank (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_bank_sample", & - "description", "Time between generations sampling source sites (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_bank_sendrecv", & - "description", "Time between generations SEND/RECVing source sites (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_tallies", & - "description", "Time between batches accumulating tallies (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_inactive", & - "description", "Total time in inactive batches (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_active", & - "description", "Total time in active batches (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_finalize", & - "description", "Total time for finalization (s)", hdf5_err) - call h5ltset_attribute_string_f(timing_group, "time_total", & - "description", "Total time elapsed (s)", hdf5_err) + call write_attribute_string("time_initialize", "description", & + "Total time elapsed for initialization (s)", group="timing") + call write_attribute_string("time_read_xs", "description", & + "Time reading cross-section libraries (s)", group="timing") + call write_attribute_string("time_unionize", "description", & + "Time unionizing energy grid (s)", group="timing") + call write_attribute_string("time_transport", "description", & + "Time in transport only (s)", group="timing") + call write_attribute_string("time_bank", "description", & + "Total time synchronizing fission bank (s)", group="timing") + call write_attribute_string("time_bank_sample", "description", & + "Time between generations sampling source sites (s)", group="timing") + call write_attribute_string("time_bank_sendrecv", "description", & + "Time between generations SEND/RECVing source sites (s)", & + group="timing") + call write_attribute_string("time_tallies", "description", & + "Time between batches accumulating tallies (s)", group="timing") + call write_attribute_string("time_inactive", "description", & + "Total time in inactive batches (s)", group="timing") + call write_attribute_string("time_active", "description", & + "Total time in active batches (s)", group="timing") + call write_attribute_string("time_finalize", "description", & + "Total time for finalization (s)", group="timing") + call 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 hdf5_write_double(timing_group, "neutrons_per_second", speed) - - ! Close timing group - call h5gclose_f(timing_group, hdf5_err) + call write_data(speed, "neutrons_per_second", group="timing") end subroutine hdf5_write_timing From d353aa5936ea1cdce3b36e661d1dc0173672abef Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 16 May 2013 16:23:53 -0400 Subject: [PATCH 25/65] removed the duplicate load_statepoint calls that were surround by compiler directives --- src/initialize.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/initialize.F90 b/src/initialize.F90 index 3c6cde1aef..3088cf8c92 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -121,12 +121,7 @@ contains ! If this is a restart run, load the state point data and binary source ! file -#ifdef HDF5 -! if (restart_run) call hdf5_load_state_point() if (restart_run) call load_state_point() -#else - if (restart_run) call load_state_point() -#endif end if if (master) then From 4644627cfadc3a5ef4fc84828f0cc91737d807f8 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 08:54:39 -0400 Subject: [PATCH 26/65] added reading or read/write mode to mpi binary and standard serial binary files when opening files --- src/mpi_interface.F90 | 17 +++++++++++++---- src/output_interface.F90 | 15 +++++++++++---- 2 files changed, 24 insertions(+), 8 deletions(-) diff --git a/src/mpi_interface.F90 b/src/mpi_interface.F90 index 4a063b75ba..c29f3dcb3b 100644 --- a/src/mpi_interface.F90 +++ b/src/mpi_interface.F90 @@ -32,14 +32,23 @@ contains ! MPI_OPEN_FILE !=============================================================================== - subroutine mpi_open_file(filename, fh) + subroutine mpi_open_file(filename, fh, mode) - character(*) :: filename - integer, intent(in) :: fh + character(*), intent(in) :: filename + character(*) intent(in) :: mode + integer, intent(in) :: fh + + integer :: open_mode + + ! Determine access mode + open_mode = MPI_MODE_RDONLY + if (mode == 'rw') then + open_mode = MPI_MODE_RDWR + end if ! Create the file call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, & - MPI_MODE_RDONLY, MPI_INFO_NULL, fh, mpi_err) + open_mode, MPI_INFO_NULL, fh, mpi_err) end subroutine mpi_open_file diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 4761021d5e..7b8099ba8e 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -66,7 +66,8 @@ contains #elif MPI call mpi_create_file(filename, mpi_fh) #else - open(UNIT=UNIT_OUTPUT, FILE=filename, STATUS='replace', ACCESS='stream') + open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION="write", & + STATUS='replace', ACCESS='stream') #endif end subroutine file_create @@ -98,9 +99,15 @@ contains call hdf5_file_open(filename, hdf5_fh, mode) # endif #elif MPI - call mpi_open_file(filename, mpi_fh) + call mpi_open_file(filename, mpi_fh, mode) #else - open(UNIT=UNIT_OUTPUT, FILE=filename, STATUS='old', ACCESS='stream') + if (mode == 'rw') then + open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION='write', & + STATUS='old', ACCESS='stream') + else + open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION='read', & + STATUS='old', ACCESS='stream') + end if #endif end subroutine file_open @@ -484,7 +491,7 @@ contains #elif MPI call mpi_read_long(mpi_fh, buffer) #else - write(UNIT_OUTPUT) buffer + read(UNIT_OUTPUT) buffer #endif end subroutine read_long From 1aadffec769c2030f4fb60d61ed04ac0d6173d82 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 08:59:17 -0400 Subject: [PATCH 27/65] fixed some comments above routines --- 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 7b8099ba8e..02dedc30af 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -165,7 +165,7 @@ contains end subroutine write_double !=============================================================================== -! READ_INTEGER +! READ_DOUBLE !=============================================================================== subroutine read_double(buffer, name, group) @@ -530,7 +530,7 @@ contains end subroutine write_string !=============================================================================== -! WRITE_STRING +! READ_STRING !=============================================================================== subroutine read_string(buffer, name, group) From 778a8aa35db2b19b167293135b1afef35adca02d Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 09:07:06 -0400 Subject: [PATCH 28/65] added missing comma when compiling with MPI --- src/mpi_interface.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mpi_interface.F90 b/src/mpi_interface.F90 index c29f3dcb3b..01d9c559f8 100644 --- a/src/mpi_interface.F90 +++ b/src/mpi_interface.F90 @@ -35,7 +35,7 @@ contains subroutine mpi_open_file(filename, fh, mode) character(*), intent(in) :: filename - character(*) intent(in) :: mode + character(*), intent(in) :: mode integer, intent(in) :: fh integer :: open_mode From 067b6870134fdc5a6676be4e83eaa53308dfb4bb Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 09:11:16 -0400 Subject: [PATCH 29/65] file extensions moved from output interface to statepoint module --- src/hdf5_summary.F90 | 2 +- src/output_interface.F90 | 12 ------------ src/state_point.F90 | 9 +++++++-- 3 files changed, 8 insertions(+), 15 deletions(-) diff --git a/src/hdf5_summary.F90 b/src/hdf5_summary.F90 index 1c8d15e585..9e90c9f230 100644 --- a/src/hdf5_summary.F90 +++ b/src/hdf5_summary.F90 @@ -22,7 +22,7 @@ contains subroutine hdf5_write_summary() - character(MAX_FILE_LEN) :: filename = "summary" + character(MAX_FILE_LEN) :: filename = "summary.h5" ! Create a new file using default properties. call file_create(filename, "serial") diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 02dedc30af..1fea06d7ef 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -47,12 +47,6 @@ contains character(*) :: filename character(*) :: fh_str -#ifdef HDF5 - filename = trim(filename) // '.h5' -#else - filename = trim(filename) // '.binary' -#endif - #ifdef HDF5 # ifdef MPI if (trim(fh_str) == 'serial') then @@ -82,12 +76,6 @@ contains character(*) :: fh_str character(*) :: mode -#ifdef HDF5 - filename = trim(filename) // '.h5' -#else - filename = trim(filename) // '.binary' -#endif - #ifdef HDF5 # ifdef MPI if (trim(fh_str) == 'serial') then diff --git a/src/state_point.F90 b/src/state_point.F90 index 5b57988f5a..d0f4550c5b 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -41,6 +41,13 @@ contains filename = trim(path_output) // 'statepoint.' // & trim(to_str(current_batch)) + ! Append appropriate extension +#ifdef HDF5 + filename = trim(filename) // '.h5' +#else + filename = trim(filename) // '.binary' +#endif + ! Write message message = "Creating state point " // trim(filename) // "..." call write_message(1) @@ -263,8 +270,6 @@ contains else ! Close HDF5 serial file and reopen in parallel call file_close('serial') - filename = trim(path_output) // 'statepoint.' // & - trim(to_str(current_batch)) call file_open(filename, 'parallel', 'rw') # endif #endif From 28f2da847b339cf1f0234341fe6b224e5d89dbbc Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 11:02:09 -0400 Subject: [PATCH 30/65] added a lot of comments and intents --- src/hdf5_interface.F90 | 273 +++++++++++++++++--------------- src/mpi_interface.F90 | 107 ++++++------- src/output_interface.F90 | 325 ++++++++++++++++++++++++++------------- 3 files changed, 418 insertions(+), 287 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 678a5b7cb3..e6fa8cc9bc 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -12,10 +12,11 @@ module hdf5_interface implicit none - integer(HID_T) :: hdf5_fh - integer(HID_T) :: temp_group - integer :: hdf5_err + integer(HID_T) :: hdf5_fh ! HDF5 file handle + integer(HID_T) :: temp_group ! temporary HDF5 group + integer :: hdf5_err ! HDF5 error code + ! Generic HDF5 write procedure interface interface hdf5_write_data module procedure hdf5_write_double module procedure hdf5_write_double_1Darray @@ -25,6 +26,7 @@ module hdf5_interface module procedure hdf5_write_string 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 @@ -37,13 +39,13 @@ module hdf5_interface contains !=============================================================================== -! HDF5_FILE_CREATE +! HDF5_FILE_CREATE creates HDF5 file !=============================================================================== subroutine hdf5_file_create(filename, file_id) - character(*) :: filename - integer(HID_T) :: file_id + character(*), intent(in) :: filename ! name of file + integer(HID_T), intent(inout) :: file_id ! file handle ! Create the file call h5fcreate_f(trim(filename), H5F_ACC_TRUNC_F, file_id, hdf5_err) @@ -51,15 +53,16 @@ contains end subroutine hdf5_file_create !=============================================================================== -! HDF5_FILE_OPEN +! HDF5_FILE_OPEN opens HDF5 file !=============================================================================== subroutine hdf5_file_open(filename, file_id, mode) - character(*) :: filename - character(*) :: mode - integer(HID_T) :: file_id - integer :: open_mode + character(*), intent(in) :: filename ! name of file + character(*), intent(in) :: mode ! access mode to file + integer(HID_T), intent(inout) :: file_id ! file handle + + integer :: open_mode ! HDF5 open mode ! Determine access type open_mode = H5F_ACC_RDONLY_F @@ -73,12 +76,12 @@ contains end subroutine hdf5_file_open !=============================================================================== -! HDF5_FILE_CLOSE +! HDF5_FILE_CLOSE closes HDF5 file !=============================================================================== subroutine hdf5_file_close(file_id) - integer(HID_T) :: file_id + integer(HID_T), intent(inout) :: file_id ! file handle ! Close the file call h5fclose_f(file_id, hdf5_err) @@ -88,14 +91,15 @@ contains #ifdef MPI !=============================================================================== -! HDF5_PARALLEL_FILE_CREATE +! HDF5_PARALLEL_FILE_CREATE creates HDF5 file with parallel I/O !=============================================================================== subroutine hdf5_parallel_file_create(filename, file_id) - character(*) :: filename - integer(HID_T) :: file_id - integer(HID_T) :: plist_id + character(*), intent(in) :: filename ! name of file + integer(HID_T), intent(inout) :: file_id ! file handle + + integer(HID_T) :: plist_id ! property list ! Setup file access property list with parallel I/O access call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) @@ -111,16 +115,17 @@ contains end subroutine hdf5_parallel_file_create !=============================================================================== -! HDF5_PARALLEL_FILE_OPEN +! HDF5_PARALLEL_FILE_OPEN opens HDF5 file with parallel I/O !=============================================================================== subroutine hdf5_parallel_file_open(filename, file_id, mode) - character(*) :: filename - character(*) :: mode - integer(HID_T) :: file_id - integer(HID_T) :: plist_id - integer :: open_mode + character(*), intent(in) :: filename ! name of file + character(*), intent(in) :: mode ! access mode + integer(HID_T), intent(inout) :: file_id ! file handle + + integer(HID_T) :: plist_id ! property list + integer :: open_mode ! HDF5 access mode ! Setup file access property list with parallel I/O access call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) @@ -144,14 +149,14 @@ contains #endif !=============================================================================== -! HDF5_OPEN_GROUP +! HDF5_OPEN_GROUP creates/opens HDF5 group to temp_group !=============================================================================== subroutine hdf5_open_group(group) - character(*) :: group + character(*), intent(in) :: group ! name of group - logical :: status + logical :: status ! does the group exist ! Check if group exists call h5ltpath_valid_f(hdf5_fh, trim(group), .true., status, hdf5_err) @@ -166,7 +171,7 @@ contains end subroutine hdf5_open_group !=============================================================================== -! HDF5_CLOSE_GROUP +! HDF5_CLOSE_GROUP closes HDF5 temp_group !=============================================================================== subroutine hdf5_close_group() @@ -177,17 +182,17 @@ contains end subroutine hdf5_close_group !=============================================================================== -! HDF5_WRITE_INTEGER +! HDF5_WRITE_INTEGER writes integer scalar data !=============================================================================== subroutine hdf5_write_integer(group, name, buffer) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - integer, intent(in) :: buffer + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + integer, intent(in) :: buffer ! data to write - integer :: rank = 1 - integer(HSIZE_T) :: dims(1) = (/1/) + integer :: rank = 1 ! rank of data + integer(HSIZE_T) :: dims(1) = (/1/) ! dimensons of array call h5ltmake_dataset_int_f(group, name, rank, dims, & (/ buffer /), hdf5_err) @@ -195,84 +200,90 @@ contains end subroutine hdf5_write_integer !=============================================================================== -! HDF5_WRITE_INTEGER_1DARRAY +! HDF5_WRITE_INTEGER_1DARRAY writes integer 1-D array !=============================================================================== subroutine hdf5_write_integer_1Darray(group, name, buffer, len) - integer, intent(in) :: len - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - integer, intent(in) :: buffer(:) + integer, intent(in) :: len ! 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 :: rank - integer(HSIZE_T) :: dims(1) + integer :: rank ! rank of data + integer(HSIZE_T) :: dims(1) ! dimensions of array + ! Set rank and dimensions of data rank = 1 dims(1) = len + ! Write data call h5ltmake_dataset_int_f(group, name, rank, dims, & buffer, hdf5_err) end subroutine hdf5_write_integer_1Darray !=============================================================================== -! HDF5_WRITE_INTEGER_2DARRAY +! HDF5_WRITE_INTEGER_2DARRAY write integer 2-D array !=============================================================================== subroutine hdf5_write_integer_2Darray(group, name, buffer, length) - integer, intent(in) :: length(2) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - integer, intent(in) :: buffer(length(1),length(2)) + 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 :: rank - integer(HSIZE_T) :: dims(2) + integer :: rank ! rank of data + integer(HSIZE_T) :: dims(2) ! dimensions of array + ! Set rank and dimensions rank = 2 dims = length + ! Write data call h5ltmake_dataset_int_f(group, name, rank, dims, & buffer, hdf5_err) end subroutine hdf5_write_integer_2Darray !=============================================================================== -! HDF5_WRITE_INTEGER_3DARRAY +! HDF5_WRITE_INTEGER_3DARRAY writes integer 3-D array !=============================================================================== subroutine hdf5_write_integer_3Darray(group, name, buffer, length) - integer, intent(in) :: length(3) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - integer, intent(in) :: buffer(length(1),length(2), length(3)) + 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 :: rank - integer(HSIZE_T) :: dims(3) + integer :: rank ! rank of data + integer(HSIZE_T) :: dims(3) ! dimensions of array + ! Set rank and dimensions rank = 3 dims = length + ! Write data call h5ltmake_dataset_int_f(group, name, rank, dims, & buffer, hdf5_err) end subroutine hdf5_write_integer_3Darray !=============================================================================== -! HDF5_WRITE_LONG +! HDF5_WRITE_LONG writes long integer data !=============================================================================== subroutine hdf5_write_long(group, name, buffer, long_type) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - integer(8), target, intent(in) :: buffer - integer(HID_T), intent(in) :: 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 - integer :: rank = 1 - integer(HSIZE_T) :: dims(1) = (/1/) + integer :: rank = 1 ! rank of data + integer(HSIZE_T) :: dims(1) = (/1/) ! dimensions of array integer(HID_T) :: dspace integer(HID_T) :: dset type(c_ptr) :: f_ptr @@ -292,17 +303,17 @@ contains end subroutine hdf5_write_long !=============================================================================== -! HDF5_WRITE_DOUBLE +! HDF5_WRITE_DOUBLE writes double precision scalar data !=============================================================================== subroutine hdf5_write_double(group, name, buffer) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - real(8), intent(in) :: 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 - integer :: rank = 1 - integer(HSIZE_T) :: dims(1) = (/1/) + integer :: rank = 1 ! rank of data + integer(HSIZE_T) :: dims(1) = (/1/) ! dimensions of array call h5ltmake_dataset_double_f(group, name, rank, dims, & (/ buffer /), hdf5_err) @@ -310,109 +321,115 @@ contains end subroutine hdf5_write_double !=============================================================================== -! HDF5_WRITE_DOUBLE_1DARRAY +! HDF5_WRITE_DOUBLE_1DARRAY writes double precision 1-D array !=============================================================================== subroutine hdf5_write_double_1Darray(group, name, buffer, len) - integer, intent(in) :: len - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - real(8), intent(in) :: buffer(:) + 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 - integer :: rank - integer(HSIZE_T) :: dims(1) + integer :: rank ! rank of data + integer(HSIZE_T) :: dims(1) ! dimensions of array + ! Set rank and dimensions of data rank = 1 dims(1) = len + ! Write data call h5ltmake_dataset_double_f(group, name, rank, dims, & buffer, hdf5_err) end subroutine hdf5_write_double_1Darray !=============================================================================== -! HDF5_WRITE_DOUBLE_2DARRAY +! HDF5_WRITE_DOUBLE_2DARRAY writes double precision 2-D array !=============================================================================== subroutine hdf5_write_double_2Darray(group, name, buffer, length) - integer, intent(in) :: length(2) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - real(8), intent(in) :: buffer(length(1),length(2)) + 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 - integer :: rank - integer(HSIZE_T) :: dims(2) + integer :: rank ! rank of data + integer(HSIZE_T) :: dims(2) ! dimensions of array + ! Set rank and dimensions of data rank = 2 dims = length + ! Write data call h5ltmake_dataset_double_f(group, name, rank, dims, & buffer, hdf5_err) end subroutine hdf5_write_double_2Darray !=============================================================================== -! HDF5_WRITE_DOUBLE_3DARRAY +! HDF5_WRITE_DOUBLE_3DARRAY writes double precision 3-D aray !=============================================================================== subroutine hdf5_write_double_3Darray(group, name, buffer, length) - integer, intent(in) :: length(3) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - real(8), intent(in) :: buffer(length(1),length(2), length(3)) + 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 - integer :: rank - integer(HSIZE_T) :: dims(3) + integer :: rank ! rank of data + integer(HSIZE_T) :: dims(3) ! dimensions of data + ! Set rank and dimensions rank = 3 dims = length + ! Write data call h5ltmake_dataset_double_f(group, name, rank, dims, & buffer, hdf5_err) end subroutine hdf5_write_double_3Darray !=============================================================================== -! HDF5_WRITE_STRING +! HDF5_WRITE_STRING writes string data !=============================================================================== subroutine hdf5_write_string(group, name, buffer) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - character(*), intent(in) :: buffer + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: name ! name of data + character(*), intent(in) :: buffer ! data to write call h5ltmake_dataset_string_f(group, name, buffer, hdf5_err) end subroutine hdf5_write_string !=============================================================================== -! HDF5_WRITE_ATTRIBUTE_STRING +! HDF5_WRITE_ATTRIBUTE_STRING writes a string attribute to a variables !=============================================================================== subroutine hdf5_write_attribute_string(group, var, attr_type, attr_str) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: var - character(*), intent(in) :: attr_type - character(*), intent(in) :: attr_str + integer(HID_T), intent(in) :: group ! name of group + character(*), intent(in) :: var ! name of varaible to set attr + character(*), intent(in) :: attr_type ! the attr type id + character(*), intent(in) :: attr_str ! attribute sting call h5ltset_attribute_string_f(group, var, attr_type, attr_str, hdf5_err) end subroutine hdf5_write_attribute_string !=============================================================================== -! HDF5_READ_INTEGER +! HDF5_READ_INTEGER reads integer scalar data !=============================================================================== subroutine hdf5_read_integer(group, name, buffer) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - integer, intent(inout) :: 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) integer(HSIZE_T) :: dims(1) = (/1/) @@ -423,34 +440,37 @@ contains end subroutine hdf5_read_integer !=============================================================================== -! HDF5_READ_INTEGER_1DARRAY +! HDF5_READ_INTEGER_1DARRAY reads integer 1-D array !=============================================================================== subroutine hdf5_read_integer_1Darray(group, name, buffer, length) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - integer, intent(inout) :: buffer(:) - integer, intent(in) :: 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 integer(HSIZE_T) :: dims(1) + ! Set dimensions dims(1) = length + + ! Read data call h5ltread_dataset_int_f(group, name, buffer, dims, hdf5_err) end subroutine hdf5_read_integer_1Darray !=============================================================================== -! HDF5_READ_LONG +! HDF5_READ_LONG read long integer scalar data !=============================================================================== subroutine hdf5_read_long(group, name, buffer, long_type) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - integer(8), target, intent(out) :: buffer - integer(HID_T), intent(in) :: 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 integer(HID_T) :: dset type(c_ptr) :: f_ptr @@ -470,14 +490,14 @@ contains end subroutine hdf5_read_long !=============================================================================== -! HDF5_READ_DOUBLE +! HDF5_READ_DOUBLE reads double precision scalar data !=============================================================================== subroutine hdf5_read_double(group, name, buffer) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - real(8), intent(out) :: 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) integer(HSIZE_T) :: dims(1) = (/1/) @@ -488,32 +508,35 @@ contains end subroutine hdf5_read_double !=============================================================================== -! HDF5_READ_DOUBLE_1DARRAY +! 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 - integer, intent(in) :: length - character(*), intent(in) :: name - real(8), intent(out) :: buffer(:) + 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 integer(HSIZE_T) :: dims(1) - + + ! Set dimensions of data dims(1) = length + + ! Read data call h5ltread_dataset_double_f(group, name, buffer, dims, hdf5_err) end subroutine hdf5_read_double_1Darray !=============================================================================== -! HDF5_READ_STRING +! HDF5_READ_STRING reads string data !=============================================================================== subroutine hdf5_read_string(group, name, buffer) - integer(HID_T), intent(in) :: group - character(*), intent(in) :: name - character(*), intent(inout) :: 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) diff --git a/src/mpi_interface.F90 b/src/mpi_interface.F90 index 01d9c559f8..871b5f55cc 100644 --- a/src/mpi_interface.F90 +++ b/src/mpi_interface.F90 @@ -6,21 +6,22 @@ module mpi_interface #ifdef MPI use mpi - implicit none -! integer :: mpi_fh + integer :: mpi_fh ! MPI file handle + + ! TODO: eventually move mpi_err to here and use this for all other MPI calls contains !=============================================================================== -! MPI_CREATE_FILE +! MPI_CREATE_FILE creates a file using MPI file I/O !=============================================================================== subroutine mpi_create_file(filename, fh) - character(*) :: filename - integer, intent(in) :: fh + character(*), intent(in) :: filename ! name of file to create + integer, intent(inout) :: fh ! file handle ! Create the file call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, MPI_MODE_CREATE + & @@ -29,14 +30,14 @@ contains end subroutine mpi_create_file !=============================================================================== -! MPI_OPEN_FILE +! MPI_OPEN_FILE opens a file using MPI file I/O !=============================================================================== subroutine mpi_open_file(filename, fh, mode) - character(*), intent(in) :: filename - character(*), intent(in) :: mode - integer, intent(in) :: fh + character(*), intent(in) :: filename ! name of file to open + character(*), intent(in) :: mode ! open 'r' read, 'rw' read/write + integer, intent(inout) :: fh ! file handle integer :: open_mode @@ -53,25 +54,25 @@ contains end subroutine mpi_open_file !=============================================================================== -! MPI_CLOSE_FILE +! MPI_CLOSE_FILE closes a file using MPI file I/O !=============================================================================== subroutine mpi_close_file(fh) - integer, intent(in) :: fh + integer, intent(inout) :: fh ! file handle call MPI_FILE_CLOSE(fh, mpi_err) end subroutine mpi_close_file !=============================================================================== -! MPI_WRITE_INTEGER +! MPI_WRITE_INTEGER writes integer scalar data using MPI File I/O !=============================================================================== subroutine mpi_write_integer(fh, buffer) - integer, intent(in) :: fh - integer, intent(in) :: buffer + integer, intent(in) :: fh ! file handle + integer, intent(in) :: buffer ! data to write call MPI_FILE_WRITE(fh, buffer, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) @@ -79,14 +80,14 @@ contains end subroutine mpi_write_integer !=============================================================================== -! MPI_WRITE_INTEGER_1DARRAY +! 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 - integer, intent(in) :: length - integer, intent(in) :: buffer(:) + 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, mpi_err) @@ -94,13 +95,13 @@ contains end subroutine mpi_write_integer_1Darray !=============================================================================== -! MPI_WRITE_LONG +! MPI_WRITE_LONG writes long integer scalar data using MPI file I/O !=============================================================================== subroutine mpi_write_long(fh, buffer) - integer, intent(in) :: fh - integer(8), intent(in) :: 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, mpi_err) @@ -108,13 +109,13 @@ contains end subroutine mpi_write_long !=============================================================================== -! MPI_WRITE_DOUBLE +! MPI_WRITE_DOUBLE writes double precision scalar data using MPI file I/O !=============================================================================== subroutine mpi_write_double(fh, buffer) - integer, intent(in) :: fh - real(8), intent(in) :: 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, mpi_err) @@ -122,14 +123,14 @@ contains end subroutine mpi_write_double !=============================================================================== -! MPI_WRITE_DOUBLE_1DARRAY +! 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 - integer, intent(in) :: length - real(8), intent(in) :: buffer(:) + 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, mpi_err) @@ -137,14 +138,14 @@ contains end subroutine mpi_write_double_1Darray !=============================================================================== -! MPI_WRITE_STRING +! MPI_WRITE_STRING writes string data using MPI file I/O !=============================================================================== subroutine mpi_write_string(fh, buffer, length) - character(*), intent(in) :: buffer - integer, intent(in) :: fh - integer, intent(in) :: 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, mpi_err) @@ -152,13 +153,13 @@ contains end subroutine mpi_write_string !=============================================================================== -! MPI_READ_INTEGER +! MPI_READ_INTEGER reads integer scalar data using MPI file I/O !=============================================================================== subroutine mpi_read_integer(fh, buffer) - integer, intent(in) :: fh - integer, intent(inout) :: buffer + integer, intent(in) :: fh ! file handle + integer, intent(inout) :: buffer ! read data to here call MPI_FILE_READ(fh, buffer, 1, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) @@ -166,14 +167,14 @@ contains end subroutine mpi_read_integer !=============================================================================== -! MPI_READ_INTEGER_1DARRAY +! MPI_READ_INTEGER_1DARRAY reads integer 1-D array using MPI file I/O !=============================================================================== subroutine mpi_read_integer_1Darray(fh, buffer, length) - integer, intent(in) :: fh - integer, intent(in) :: length - integer, intent(inout) :: buffer(:) + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length ! length of array + integer, intent(inout) :: buffer(:) ! read data to here call MPI_FILE_READ(fh, buffer, length, MPI_INTEGER, & MPI_STATUS_IGNORE, mpi_err) @@ -181,13 +182,13 @@ contains end subroutine mpi_read_integer_1Darray !=============================================================================== -! MPI_READ_LONG +! MPI_READ_LONG reads long integer scalar data using MPI file I/O !=============================================================================== subroutine mpi_read_long(fh, buffer) - integer, intent(in) :: fh - integer(8), intent(inout) :: buffer + integer, intent(in) :: fh ! file handle + integer(8), intent(inout) :: buffer ! read data to here call MPI_FILE_READ(fh, buffer, 1, MPI_INTEGER8, & MPI_STATUS_IGNORE, mpi_err) @@ -195,13 +196,13 @@ contains end subroutine mpi_read_long !=============================================================================== -! MPI_READ_DOUBLE +! MPI_READ_DOUBLE reads double precision scalar data using MPI file I/O !=============================================================================== subroutine mpi_read_double(fh, buffer) - integer, intent(in) :: fh - real(8), intent(inout) :: buffer + integer, intent(in) :: fh ! file handle + real(8), intent(inout) :: buffer ! read data to here call MPI_FILE_READ(fh, buffer, 1, MPI_REAL8, & MPI_STATUS_IGNORE, mpi_err) @@ -209,14 +210,14 @@ contains end subroutine mpi_read_double !=============================================================================== -! MPI_READ_DOUBLE_1DARRAY +! 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 - integer, intent(in) :: length - real(8), intent(inout) :: buffer(:) + 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, mpi_err) @@ -224,14 +225,14 @@ contains end subroutine mpi_read_double_1Darray !=============================================================================== -! MPI_READ_STRING +! MPI_READ_STRING reads string data using MPI file I/O !=============================================================================== subroutine mpi_read_string(fh, buffer, length) - character(*), intent(inout) :: buffer - integer, intent(in) :: fh - integer, intent(in) :: length + character(*), intent(inout) :: buffer ! read data to here + integer, intent(in) :: fh ! file handle + integer, intent(in) :: length ! length of string call MPI_FILE_READ(fh, buffer, length, MPI_CHARACTER, & MPI_STATUS_IGNORE, mpi_err) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 1fea06d7ef..5043141efb 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -1,6 +1,7 @@ module output_interface use constants + use error, only: warning use global use tally_header, only: TallyResult @@ -12,8 +13,7 @@ module output_interface implicit none - integer :: mpi_fh - + ! Generic write procedure interface interface write_data module procedure write_double module procedure write_double_1Darray @@ -27,6 +27,7 @@ module output_interface module procedure write_string end interface write_data + ! Generic read procedure interface interface read_data module procedure read_double module procedure read_double_1Darray @@ -39,16 +40,17 @@ module output_interface contains !=============================================================================== -! FILE_CREATE +! FILE_CREATE creates a new file to write data to !=============================================================================== subroutine file_create(filename, fh_str) - character(*) :: filename - character(*) :: fh_str + character(*), intent(in) :: filename ! name of file to be created + character(*), intent(in) :: fh_str ! parallel or serial HDF5 file #ifdef HDF5 # ifdef MPI + ! Determine whether the file should be created by 1 or all procs if (trim(fh_str) == 'serial') then if(master) call hdf5_file_create(filename, hdf5_fh) else @@ -67,17 +69,18 @@ contains end subroutine file_create !=============================================================================== -! FILE_OPEN +! FILE_OPEN opens an existing file for reading or read/writing !=============================================================================== subroutine file_open(filename, fh_str, mode) - character(*) :: filename - character(*) :: fh_str - character(*) :: mode + character(*), intent(in) :: filename ! name of file to be opened + character(*), intent(in) :: fh_str ! parallel or serial HDF5 file + character(*), intent(in) :: mode ! open mode 'r' read, 'rw' read/write #ifdef HDF5 # ifdef MPI + ! Determine if the file should be opened by 1 or all procs if (trim(fh_str) == 'serial') then if (master) call hdf5_file_open(filename, hdf5_fh, mode) else @@ -89,6 +92,7 @@ contains #elif MPI call mpi_open_file(filename, mpi_fh, mode) #else + ! Check for read/write mode to open, default is read only if (mode == 'rw') then open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION='write', & STATUS='old', ACCESS='stream') @@ -101,15 +105,16 @@ contains end subroutine file_open !=============================================================================== -! FILE_CLOSE +! FILE_CLOSE closes a file !=============================================================================== subroutine file_close(fh_str) - character(*) :: fh_str + character(*), intent(in) :: fh_str ! serial or parallel hdf5 file #ifdef HDF5 # ifdef MPI + ! Determine whether a file should be closed by 1 or all procs if (trim(fh_str) == 'serial') then if(master) call hdf5_file_close(hdf5_fh) else @@ -127,22 +132,27 @@ contains end subroutine file_close !=============================================================================== -! WRITE_DOUBLE +! WRITE_DOUBLE writes double precision scalar data !=============================================================================== subroutine write_double(buffer, name, group) - real(8), intent(in) :: buffer - character(*), intent(in) :: name - character(*), intent(in), optional :: group + real(8), intent(in) :: buffer ! data to write + character(*), intent(in) :: name ! name for 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(temp_group, name, buffer) + + ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI call mpi_write_double(mpi_fh, buffer) @@ -153,22 +163,27 @@ contains end subroutine write_double !=============================================================================== -! READ_DOUBLE +! READ_DOUBLE reads double precision scalar data !=============================================================================== subroutine read_double(buffer, name, group) - real(8), intent(inout) :: buffer - character(*), intent(in) :: name - character(*), intent(in), optional :: group + real(8), intent(inout) :: buffer ! read data to here + character(*), intent(in) :: name ! name for 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 + + ! Read the data call hdf5_read_double(temp_group, name, buffer) + + ! Check if HDf5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI call mpi_read_double(mpi_fh, buffer) @@ -179,23 +194,28 @@ contains end subroutine read_double !=============================================================================== -! WRITE_DOUBLE_1DARRAY +! WRITE_DOUBLE_1DARRAY writes double presicions 1-D array data !=============================================================================== subroutine write_double_1Darray(buffer, name, group, length) - integer, intent(in) :: length - real(8), intent(in) :: buffer(:) - character(*), intent(in) :: name - character(*), intent(in), optional :: group + 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 #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_1Darray(temp_group, name, buffer, length) + + ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI call mpi_write_double_1Darray(mpi_fh, buffer, length) @@ -206,23 +226,28 @@ contains end subroutine write_double_1Darray !=============================================================================== -! READ_DOUBLE_1DARRAY +! READ_DOUBLE_1DARRAY reads double precision 1-D array data !=============================================================================== subroutine read_double_1Darray(buffer, name, group, length) - integer, intent(in) :: length - real(8), intent(inout) :: buffer(:) - character(*), intent(in) :: name - character(*), intent(in), optional :: group + 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 #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 + + ! Read the data call hdf5_read_double_1Darray(temp_group, name, buffer, length) + + ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI call mpi_read_double_1Darray(mpi_fh, buffer, length) @@ -233,69 +258,89 @@ contains end subroutine read_double_1Darray !=============================================================================== -! WRITE_DOUBLE_2DARRAY +! WRITE_DOUBLE_2DARRAY writes double precision 2-D array data !=============================================================================== subroutine write_double_2Darray(buffer, name, group, length) - integer, intent(in) :: length(2) - real(8), intent(in) :: buffer(length(1),length(2)) - character(*), intent(in) :: name - character(*), intent(in), optional :: group + 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 #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_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 +! WRITE_DOUBLE_3DARRAY writes double precision 3-D array data !=============================================================================== subroutine write_double_3Darray(buffer, name, group, length) - integer, intent(in) :: length(3) - real(8), intent(in) :: buffer(length(1),length(2), & - length(3)) - character(*), intent(in) :: name - character(*), intent(in), optional :: group + 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 +! WRITE_INTEGER writes integer scalar data !=============================================================================== subroutine write_integer(buffer, name, group) - integer, intent(in) :: buffer - character(*), intent(in) :: name - character(*), intent(in), optional :: 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) @@ -306,22 +351,27 @@ contains end subroutine write_integer !=============================================================================== -! READ_INTEGER +! READ_INTEGER reads integer scalar data !=============================================================================== subroutine read_integer(buffer, name, group) - integer, intent(inout) :: buffer - character(*), intent(in) :: name - character(*), intent(in), optional :: group + integer, intent(inout) :: buffer ! read data to here + 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 + + ! Read the data call hdf5_read_integer(temp_group, name, buffer) + + ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI call mpi_read_integer(mpi_fh, buffer) @@ -332,23 +382,29 @@ contains end subroutine read_integer !=============================================================================== -! WRITE_INTEGER_1DARRAY +! WRITE_INTEGER_1DARRAY writes integer 1-D array data !=============================================================================== subroutine write_integer_1Darray(buffer, name, group, length) - integer, intent(in) :: length - integer, intent(in) :: buffer(:) - character(*), intent(in) :: name - character(*), intent(in), optional :: group + 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 #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_integer_1Darray(temp_group, name, buffer, length) + + ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI call mpi_write_integer_1Darray(mpi_fh, buffer, length) @@ -359,22 +415,25 @@ contains end subroutine write_integer_1Darray !=============================================================================== -! READ_INTEGER_1DARRAY +! READ_INTEGER_1DARRAY reads integer 1-D array data !=============================================================================== subroutine read_integer_1Darray(buffer, name, group, length) - integer, intent(in) :: length - integer, intent(inout) :: buffer(:) - character(*), intent(in) :: name - character(*), intent(in), optional :: group + 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 #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 + + ! Read the data call hdf5_read_integer_1Darray(temp_group, name, buffer, length) if (present(group)) call hdf5_close_group() #elif MPI @@ -386,69 +445,89 @@ contains end subroutine read_integer_1Darray !=============================================================================== -! WRITE_INTEGER_2DARRAY +! WRITE_INTEGER_2DARRAY writes integer 2-D array data !=============================================================================== subroutine write_integer_2Darray(buffer, name, group, length) - integer, intent(in) :: length(2) - integer, intent(in) :: buffer(length(1),length(2)) - character(*), intent(in) :: name - character(*), intent(in), optional :: group + integer, intent(in) :: length(2) ! length of dimensions + integer, intent(in) :: buffer(length(1),length(2)) ! data + 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_integer_2Darray(temp_group, name, buffer, length) + + ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() +#else + message = 'Integer 2-D array writing not currently supported' + call warning() #endif end subroutine write_integer_2Darray !=============================================================================== -! WRITE_DOUBLE_3DARRAY +! WRITE_INTEGER_3DARRAY writes integer 3-D array data !=============================================================================== subroutine write_integer_3Darray(buffer, name, group, length) - integer, intent(in) :: length(3) - integer, intent(in) :: buffer(length(1),length(2), & - length(3)) - character(*), intent(in) :: name - character(*), intent(in), optional :: group + integer, intent(in) :: length(3) ! length of dimensions + 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 #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_integer_3Darray(temp_group, name, buffer, length) + + ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() +#else + message = 'Integer 3-D array writing not currently supported' + call warning() #endif end subroutine write_integer_3Darray !=============================================================================== -! WRITE_LONG +! WRITE_LONG writes long integer scalar data !=============================================================================== subroutine write_long(buffer, name, group) - integer(8), intent(in) :: buffer - character(*), intent(in) :: name - character(*), intent(in), optional :: group + integer(8), 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 the data call hdf5_write_long(temp_group, name, buffer, hdf5_integer8_t) + + ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI call mpi_write_long(mpi_fh, buffer) @@ -459,22 +538,27 @@ contains end subroutine write_long !=============================================================================== -! READ_LONG +! READ_LONG reads long integer scalar data !=============================================================================== subroutine read_long(buffer, name, group) - integer(8), intent(inout) :: buffer - character(*), intent(in) :: name - character(*), intent(in), optional :: group + integer(8), intent(inout) :: buffer ! read data to here + 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 + + ! Read the data call hdf5_read_long(temp_group, name, buffer, hdf5_integer8_t) + + ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI call mpi_read_long(mpi_fh, buffer) @@ -485,31 +569,39 @@ contains end subroutine read_long !=============================================================================== -! WRITE_STRING +! WRITE_STRING writes string data !=============================================================================== subroutine write_string(buffer, name, group) - character(*), intent(in) :: buffer - character(*), intent(in) :: name - character(*), intent(in), optional :: group + character(*), intent(in) :: buffer ! data to write + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name #ifndef HDF5 # ifdef MPI - integer :: n + integer :: n ! length of string buffer to write # endif #endif #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_string(temp_group, name, buffer) + + ! 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) #else write(UNIT_OUTPUT) buffer @@ -518,31 +610,40 @@ contains end subroutine write_string !=============================================================================== -! READ_STRING +! READ_STRING reads string data !=============================================================================== subroutine read_string(buffer, name, group) - character(*), intent(inout) :: buffer - character(*), intent(in) :: name - character(*), intent(in), optional :: group + character(*), intent(inout) :: buffer ! read data to here + character(*), intent(in) :: name ! name of data + character(*), intent(in), optional :: group ! HDF5 group name #ifndef HDF5 # ifdef MPI - integer :: n + integer :: n ! length of string to read to # endif #endif #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 + + ! Read the data call hdf5_read_string(temp_group, name, buffer) + + ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI + + ! Length of string buffer to read n = len(buffer) + + ! Read the data call mpi_read_string(mpi_fh, buffer, n) #else read(UNIT_OUTPUT) buffer @@ -556,32 +657,38 @@ contains subroutine write_attribute_string(var, attr_type, attr_str, group) - character(*), intent(in) :: var - character(*), intent(in) :: attr_type - character(*), intent(in) :: attr_str - character(*), intent(in), optional :: 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 #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 attribute string call hdf5_write_attribute_string(temp_group, var, attr_type, attr_str) + + ! Check if HDF5 group should be closed + if (present(group)) call hdf5_close_group() #endif end subroutine write_attribute_string !=============================================================================== -! WRITE_TALLY_RESULT +! WRITE_TALLY_RESULT writes an OpenMC TallyResult type !=============================================================================== subroutine write_tally_result(buffer, name, group, n1, n2) - character(*), intent(in), optional :: group - character(*), intent(in) :: name - integer, intent(in) :: n1, n2 - type(TallyResult), intent(in), target :: buffer(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 #ifdef HDF5 integer :: hdf5_err @@ -591,7 +698,7 @@ contains type(c_ptr) :: f_ptr #elif MPI #else - integer :: j,k + integer :: j,k ! iteration counters #endif #ifdef HDF5 @@ -645,15 +752,15 @@ contains end subroutine write_tally_result !=============================================================================== -! READ_TALLY_RESULT +! READ_TALLY_RESULT reads OpenMC TallyResult data !=============================================================================== subroutine read_tally_result(buffer, name, group, n1, n2) - character(*), intent(in), optional :: group - character(*), intent(in) :: name - integer, intent(in) :: n1, n2 - type(TallyResult), intent(inout), target :: buffer(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 #ifdef HDF5 integer :: hdf5_err @@ -662,7 +769,7 @@ contains type(c_ptr) :: f_ptr #elif MPI #else - integer :: j,k + integer :: j,k ! iteration counters #endif #ifdef HDF5 @@ -712,7 +819,7 @@ contains !=============================================================================== -! WRITE_SOURCE_BANK +! WRITE_SOURCE_BANK writes OpenMC source_bank data !=============================================================================== subroutine write_source_bank() @@ -728,8 +835,8 @@ contains type(c_ptr) :: f_ptr #elif MPI integer(MPI_OFFSET_KIND) :: offset - integer :: size_offset_kind - integer :: size_bank + integer :: size_offset_kind ! the data offset kind + integer :: size_bank ! size of bank to write #endif #ifdef HDF5 @@ -833,7 +940,7 @@ contains end subroutine write_source_bank !=============================================================================== -! READ_SOURCE_BANK +! READ_SOURCE_BANK reads OpenMC source_bank data !=============================================================================== subroutine read_source_bank() @@ -849,8 +956,8 @@ contains type(c_ptr) :: f_ptr #elif MPI integer(MPI_OFFSET_KIND) :: offset - integer :: size_offset_kind - integer :: size_bank + integer :: size_offset_kind ! the data offset kind + integer :: size_bank ! size of bank to read #endif #ifdef HDF5 From e6a3909722837615e647d5732be0d563beb637f5 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 11:44:45 -0400 Subject: [PATCH 31/65] put common temporary hdf5 variables at top of hdf5 module --- src/hdf5_interface.F90 | 148 ++++++++++++++++++--------------------- src/output_interface.F90 | 84 +++++++--------------- 2 files changed, 95 insertions(+), 137 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index e6fa8cc9bc..e9247dedf8 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -12,9 +12,18 @@ module hdf5_interface implicit none - integer(HID_T) :: hdf5_fh ! HDF5 file handle - integer(HID_T) :: temp_group ! temporary HDF5 group - integer :: hdf5_err ! HDF5 error code + integer :: hdf5_err ! HDF5 error code + 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 + integer(HSIZE_T) :: dims2(2) ! dims type for 2-D array + integer(HSIZE_T) :: dims3(3) ! dims type for 3-D array + type(c_ptr) :: f_ptr ! pointer to data ! Generic HDF5 write procedure interface interface hdf5_write_data @@ -99,18 +108,16 @@ contains character(*), intent(in) :: filename ! name of file integer(HID_T), intent(inout) :: file_id ! file handle - integer(HID_T) :: plist_id ! property list - ! Setup file access property list with parallel I/O access - call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) - call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) + call h5pcreate_f(H5P_FILE_ACCESS_F, plist, hdf5_err) + call h5pset_fapl_mpio_f(plist, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) ! Create the file collectively call h5fcreate_f(trim(filename), H5F_ACC_TRUNC_F, file_id, hdf5_err, & - access_prp = plist_id) + access_prp = plist) ! Close the property list - call h5pclose_f(plist_id, hdf5_err) + call h5pclose_f(plist, hdf5_err) end subroutine hdf5_parallel_file_create @@ -124,12 +131,11 @@ contains character(*), intent(in) :: mode ! access mode integer(HID_T), intent(inout) :: file_id ! file handle - integer(HID_T) :: plist_id ! property list integer :: open_mode ! HDF5 access mode ! Setup file access property list with parallel I/O access - call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdf5_err) - call h5pset_fapl_mpio_f(plist_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) + call h5pcreate_f(H5P_FILE_ACCESS_F, plist, hdf5_err) + call h5pset_fapl_mpio_f(plist, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) ! Determine access type open_mode = H5F_ACC_RDONLY_F @@ -139,10 +145,10 @@ contains ! Create the file collectively call h5fopen_f(trim(filename), open_mode, file_id, hdf5_err, & - access_prp = plist_id) + access_prp = plist) ! Close the property list - call h5pclose_f(plist_id, hdf5_err) + call h5pclose_f(plist, hdf5_err) end subroutine hdf5_parallel_file_open @@ -191,10 +197,11 @@ contains character(*), intent(in) :: name ! name of data integer, intent(in) :: buffer ! data to write - integer :: rank = 1 ! rank of data - integer(HSIZE_T) :: dims(1) = (/1/) ! dimensons of array + ! Set rank and dimensions + hdf5_rank = 1 + dims1(1) = 1 - call h5ltmake_dataset_int_f(group, name, rank, dims, & + call h5ltmake_dataset_int_f(group, name, hdf5_rank, dims1, & (/ buffer /), hdf5_err) end subroutine hdf5_write_integer @@ -210,15 +217,12 @@ contains character(*), intent(in) :: name ! name of data integer, intent(in) :: buffer(:) ! data to write - integer :: rank ! rank of data - integer(HSIZE_T) :: dims(1) ! dimensions of array - ! Set rank and dimensions of data - rank = 1 - dims(1) = len + hdf5_rank = 1 + dims1(1) = len ! Write data - call h5ltmake_dataset_int_f(group, name, rank, dims, & + call h5ltmake_dataset_int_f(group, name, hdf5_rank, dims1, & buffer, hdf5_err) end subroutine hdf5_write_integer_1Darray @@ -234,15 +238,12 @@ contains character(*), intent(in) :: name ! name of data integer, intent(in) :: buffer(length(1),length(2)) ! data to write - integer :: rank ! rank of data - integer(HSIZE_T) :: dims(2) ! dimensions of array - ! Set rank and dimensions - rank = 2 - dims = length + hdf5_rank = 2 + dims2 = length ! Write data - call h5ltmake_dataset_int_f(group, name, rank, dims, & + call h5ltmake_dataset_int_f(group, name, hdf5_rank, dims2, & buffer, hdf5_err) end subroutine hdf5_write_integer_2Darray @@ -258,21 +259,18 @@ contains character(*), intent(in) :: name ! name of data integer, intent(in) :: buffer(length(1),length(2), length(3)) ! data - integer :: rank ! rank of data - integer(HSIZE_T) :: dims(3) ! dimensions of array - ! Set rank and dimensions - rank = 3 - dims = length + hdf5_rank = 3 + dims3 = length ! Write data - call h5ltmake_dataset_int_f(group, name, rank, dims, & + call h5ltmake_dataset_int_f(group, name, hdf5_rank, dims3, & buffer, hdf5_err) end subroutine hdf5_write_integer_3Darray !=============================================================================== -! HDF5_WRITE_LONG writes long integer data +! HDF5_WRITE_LONG writes long integer scalar data !=============================================================================== subroutine hdf5_write_long(group, name, buffer, long_type) @@ -282,14 +280,12 @@ contains integer(8), target, intent(in) :: buffer ! data to write integer(HID_T), intent(in) :: long_type ! HDF5 long type - integer :: rank = 1 ! rank of data - integer(HSIZE_T) :: dims(1) = (/1/) ! dimensions of array - integer(HID_T) :: dspace - integer(HID_T) :: dset - type(c_ptr) :: f_ptr + ! Set up rank and dimensions + hdf5_rank = 1 + dims1(1) = 1 ! Create dataspace and dataset - call h5screate_simple_f(rank, dims, dspace, hdf5_err) + 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 @@ -312,10 +308,12 @@ contains character(*), intent(in) :: name ! name of data real(8), intent(in) :: buffer ! data to write - integer :: rank = 1 ! rank of data - integer(HSIZE_T) :: dims(1) = (/1/) ! dimensions of array + ! Set up rank and dimensions + hdf5_rank = 1 + dims1(1) = 1 - call h5ltmake_dataset_double_f(group, name, rank, dims, & + ! Write data + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & (/ buffer /), hdf5_err) end subroutine hdf5_write_double @@ -331,15 +329,12 @@ contains character(*), intent(in) :: name ! name of data real(8), intent(in) :: buffer(:) ! data to write - integer :: rank ! rank of data - integer(HSIZE_T) :: dims(1) ! dimensions of array - ! Set rank and dimensions of data - rank = 1 - dims(1) = len + hdf5_rank = 1 + dims1(1) = len ! Write data - call h5ltmake_dataset_double_f(group, name, rank, dims, & + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & buffer, hdf5_err) end subroutine hdf5_write_double_1Darray @@ -355,15 +350,12 @@ contains character(*), intent(in) :: name ! name of data real(8), intent(in) :: buffer(length(1),length(2)) ! data to write - integer :: rank ! rank of data - integer(HSIZE_T) :: dims(2) ! dimensions of array - ! Set rank and dimensions of data - rank = 2 - dims = length + hdf5_rank = 2 + dims2 = length ! Write data - call h5ltmake_dataset_double_f(group, name, rank, dims, & + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims2, & buffer, hdf5_err) end subroutine hdf5_write_double_2Darray @@ -379,15 +371,12 @@ contains character(*), intent(in) :: name ! name of data real(8), intent(in) :: buffer(length(1),length(2), length(3)) ! data - integer :: rank ! rank of data - integer(HSIZE_T) :: dims(3) ! dimensions of data - ! Set rank and dimensions - rank = 3 - dims = length + hdf5_rank = 3 + dims3 = length ! Write data - call h5ltmake_dataset_double_f(group, name, rank, dims, & + call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims3, & buffer, hdf5_err) end subroutine hdf5_write_double_3Darray @@ -431,10 +420,13 @@ contains character(*), intent(in) :: name ! name of data integer, intent(inout) :: buffer ! read data to here - integer :: buffer_copy(1) - integer(HSIZE_T) :: dims(1) = (/1/) + integer :: buffer_copy(1) ! need an array for read - call h5ltread_dataset_int_f(group, name, buffer_copy, dims, hdf5_err) + ! 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 @@ -450,13 +442,11 @@ contains integer, intent(inout) :: buffer(:) ! read data to here integer, intent(in) :: length ! length of array - integer(HSIZE_T) :: dims(1) - ! Set dimensions - dims(1) = length + dims1(1) = length ! Read data - call h5ltread_dataset_int_f(group, name, buffer, dims, hdf5_err) + call h5ltread_dataset_int_f(group, name, buffer, dims1, hdf5_err) end subroutine hdf5_read_integer_1Darray @@ -472,9 +462,6 @@ contains integer(8), target, intent(out) :: buffer ! read data to here integer(HID_T), intent(in) :: long_type ! long integer type - integer(HID_T) :: dset - type(c_ptr) :: f_ptr - ! Open dataset call h5dopen_f(group, name, dset, hdf5_err) @@ -499,10 +486,13 @@ contains character(*), intent(in) :: name ! name of data real(8), intent(inout) :: buffer ! read data to here - real(8) :: buffer_copy(1) - integer(HSIZE_T) :: dims(1) = (/1/) + real(8) :: buffer_copy(1) ! need an array for read - call h5ltread_dataset_double_f(group, name, buffer_copy, dims, hdf5_err) + ! 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 @@ -518,13 +508,11 @@ contains character(*), intent(in) :: name ! name of data real(8), intent(inout) :: buffer(:) ! read data to here - integer(HSIZE_T) :: dims(1) - ! Set dimensions of data - dims(1) = length + dims1(1) = length ! Read data - call h5ltread_dataset_double_f(group, name, buffer, dims, hdf5_err) + call h5ltread_dataset_double_f(group, name, buffer, dims1, hdf5_err) end subroutine hdf5_read_double_1Darray diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 5043141efb..31a4e1583a 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -690,15 +690,10 @@ contains integer, intent(in) :: n1, n2 ! TallyResult dims type(TallyResult), intent(in), target :: buffer(n1, n2) ! data to write -#ifdef HDF5 - integer :: hdf5_err - integer(HSIZE_T) :: dims(1) - integer(HID_T) :: dspace - integer(HID_T) :: dset - type(c_ptr) :: f_ptr -#elif MPI -#else +#ifndef HDF5 +# ifndef MPI integer :: j,k ! iteration counters +# endif #endif #ifdef HDF5 @@ -711,10 +706,10 @@ contains end if ! Set overall size of vector to write - dims(1) = n1*n2 + dims1(1) = n1*n2 ! Create up a dataspace for size - call h5screate_simple_f(1, dims, dspace, hdf5_err) + call h5screate_simple_f(1, dims1, dspace, hdf5_err) ! Create the dataset call h5dcreate_f(temp_group, name, hdf5_tallyresult_t, dspace, dset, & @@ -762,14 +757,10 @@ contains integer, intent(in) :: n1, n2 ! TallyResult dims type(TallyResult), intent(inout), target :: buffer(n1, n2) ! read data here -#ifdef HDF5 - integer :: hdf5_err - integer(HSIZE_T) :: dims(1) - integer(HID_T) :: dset - type(c_ptr) :: f_ptr -#elif MPI -#else +#ifndef HDF5 +# ifndef MPI integer :: j,k ! iteration counters +# endif #endif #ifdef HDF5 @@ -781,9 +772,6 @@ contains temp_group = hdf5_fh end if - ! Set overall size of vector to read - dims(1) = n1*n2 - ! Open the dataset call h5dopen_f(temp_group, name, dset, hdf5_err) @@ -793,9 +781,7 @@ contains ! Close ids call h5dclose_f(dset, hdf5_err) - if (present(group)) then - call hdf5_close_group() - end if + if (present(group)) call hdf5_close_group() #elif MPI @@ -825,16 +811,9 @@ contains subroutine write_source_bank() #ifdef HDF5 - integer(HSIZE_T) :: dims(1) - integer(HID_T) :: dset - integer(HID_T) :: dspace - integer(HID_T) :: memspace - integer(HID_T) :: plist - integer :: rank - integer(8) :: offset(1) - type(c_ptr) :: f_ptr + integer(8) :: offset(1) ! source data offset #elif MPI - integer(MPI_OFFSET_KIND) :: offset + integer(MPI_OFFSET_KIND) :: offset ! offset of data integer :: size_offset_kind ! the data offset kind integer :: size_bank ! size of bank to write #endif @@ -843,11 +822,11 @@ contains # ifdef MPI ! Set size of total dataspace for all procs and rank - dims(1) = n_particles - rank = 1 + dims1(1) = n_particles + hdf5_rank = 1 ! Create that dataspace - call h5screate_simple_f(rank, dims, dspace, hdf5_err) + 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) @@ -856,15 +835,15 @@ contains call h5sclose_f(dspace, hdf5_err) ! Create another data space but for each proc individually - dims(1) = work - call h5screate_simple_f(rank, dims, memspace, hdf5_err) + dims1(1) = work + call h5screate_simple_f(hdf5_rank, dims1, memspace, hdf5_err) ! Get the individual local proc dataspace call h5dget_space_f(dset, dspace, hdf5_err) ! Select hyperslab for this dataspace offset(1) = bank_first - 1_8 - call h5sselect_hyperslab_f(dspace, H5S_SELECT_SET_F, offset, dims, hdf5_err) + call h5sselect_hyperslab_f(dspace, H5S_SELECT_SET_F, offset, dims1, hdf5_err) ! Set up the property list for parallel writing call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) @@ -887,10 +866,11 @@ contains # else ! Set size - dims(1) = work + dims1(1) = work + rank_data = 1 ! Create dataspace - call h5screate_simple_f(1, dims, dspace, hdf5_err) + call h5screate_simple_f(rank_data, dims1, dspace, hdf5_err) ! Create dataset call h5dcreate_f(hdf5_fh, "source_bank", hdf5_bank_t, & @@ -946,16 +926,9 @@ contains subroutine read_source_bank() #ifdef HDF5 - integer(HSIZE_T) :: dims(1) - integer(HID_T) :: dset - integer(HID_T) :: dspace - integer(HID_T) :: memspace - integer(HID_T) :: plist - integer :: rank - integer(8) :: offset(1) - type(c_ptr) :: f_ptr + integer(8) :: offset(1) ! offset of data #elif MPI - integer(MPI_OFFSET_KIND) :: offset + integer(MPI_OFFSET_KIND) :: offset ! offset of data integer :: size_offset_kind ! the data offset kind integer :: size_bank ! size of bank to read #endif @@ -964,22 +937,22 @@ contains # ifdef MPI ! Set size of total dataspace for all procs and rank - dims(1) = n_particles - rank = 1 + dims1(1) = n_particles + hdf5_rank = 1 ! Open the dataset call h5dopen_f(hdf5_fh, "source_bank", dset, hdf5_err) ! Create another data space but for each proc individually - dims(1) = work - call h5screate_simple_f(rank, dims, memspace, hdf5_err) + dims1(1) = work + call h5screate_simple_f(hdf5_rank, dims1, memspace, hdf5_err) ! Get the individual local proc dataspace call h5dget_space_f(dset, dspace, hdf5_err) ! Select hyperslab for this dataspace offset(1) = bank_first - 1_8 - call h5sselect_hyperslab_f(dspace, H5S_SELECT_SET_F, offset, dims, hdf5_err) + call h5sselect_hyperslab_f(dspace, H5S_SELECT_SET_F, offset, dims1, hdf5_err) ! Set up the property list for parallel writing call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) @@ -1001,9 +974,6 @@ contains # else - ! Set size - dims(1) = work - ! Open dataset call h5dopen_f(hdf5_fh, "source_bank", dset, hdf5_err) From 9ca99af8d707c466719f52c090cec40586f44915 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 12:12:11 -0400 Subject: [PATCH 32/65] changed rank_data to hdf5_rank --- 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 31a4e1583a..72691baad9 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -867,10 +867,10 @@ contains ! Set size dims1(1) = work - rank_data = 1 + hdf5_rank = 1 ! Create dataspace - call h5screate_simple_f(rank_data, dims1, dspace, hdf5_err) + call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) ! Create dataset call h5dcreate_f(hdf5_fh, "source_bank", hdf5_bank_t, & From 40a649b9a09e7f491765b7f4205d7083200fbe04 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 12:12:32 -0400 Subject: [PATCH 33/65] extension for separate source file now appended in statepoint module --- src/state_point.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/state_point.F90 b/src/state_point.F90 index d0f4550c5b..e11ea72fc9 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -257,6 +257,11 @@ contains ! Set filename for source filename = trim(path_output) // 'source.' // & trim(to_str(current_batch)) +#ifdef HDF5 + filename = trim(filename) // '.h5' +#else + filename = trim(filename) // '.binary' +#endif ! Write message message = "Creating source file " // trim(filename) // "..." @@ -531,6 +536,11 @@ contains ! Set filename for source filename = trim(path_output) // 'source.' // & trim(to_str(restart_batch)) +#ifdef HDF5 + filename = trim(filename) // '.h5' +#else + filename = trim(filename) // '.binary' +#endif ! Write message message = "Loading source file " // trim(filename) // "..." From cf5f00c32adbb0cd008923fd6b8544f67fece221 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 12:21:31 -0400 Subject: [PATCH 34/65] change hdf5 to hdf5 interface in global module and fixed dependency in finalize module --- src/finalize.F90 | 2 +- src/global.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/finalize.F90 b/src/finalize.F90 index 2e51362b94..bf0c752ffb 100644 --- a/src/finalize.F90 +++ b/src/finalize.F90 @@ -12,7 +12,7 @@ module finalize #endif #ifdef HDF5 - use hdf5_interface, only: hdf5_err + use hdf5_interface, only: h5tclose_f, h5close_f, hdf5_err #endif implicit none diff --git a/src/global.F90 b/src/global.F90 index c18a7f483a..9a64a7bce0 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -21,7 +21,7 @@ module global #endif #ifdef HDF5 - use hdf5 + use hdf5_interface, only: HID_T #endif implicit none From 9f7574c1f3aae522bf838fdf52a9113455838bff Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 12:26:58 -0400 Subject: [PATCH 35/65] disabled starting from source file option --- src/source.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/source.F90 b/src/source.F90 index d0baeeb706..ab115615ab 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -9,7 +9,6 @@ module source use particle_header, only: deallocate_coord use physics, only: maxwell_spectrum, watt_spectrum use random_lcg, only: prn, set_particle_seed - use state_point, only: read_source use string, only: to_str #ifdef MPI @@ -38,7 +37,8 @@ contains ! Read the source from a binary file instead of sampling from some ! assumed source distribution - call read_source() + message = 'This feature is currently disabled and will be added back in.' + call fatal_error() else ! Generation source sites from specified distribution in user input From 0b10fd657afd5231b72a1bd0dfce07a8a1e10bd5 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 13:46:40 -0400 Subject: [PATCH 36/65] now any mpi task can open up an HDF5 in serial mode --- src/output_interface.F90 | 42 ++++++++++++++++++++++++++++------------ 1 file changed, 30 insertions(+), 12 deletions(-) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 72691baad9..2560c36575 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -43,16 +43,22 @@ contains ! FILE_CREATE creates a new file to write data to !=============================================================================== - subroutine file_create(filename, fh_str) + subroutine file_create(filename, fh_str, proc_id) - character(*), intent(in) :: filename ! name of file to be created - character(*), intent(in) :: fh_str ! parallel or serial HDF5 file + 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 + + integer :: proc_create = 0 ! processor writing in serial (default master) #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(master) call hdf5_file_create(filename, hdf5_fh) + if(rank == proc_create) call hdf5_file_create(filename, hdf5_fh) else call hdf5_parallel_file_create(filename, hdf5_fh) endif @@ -72,17 +78,23 @@ contains ! FILE_OPEN opens an existing file for reading or read/writing !=============================================================================== - subroutine file_open(filename, fh_str, mode) + subroutine file_open(filename, fh_str, mode, proc_id) - character(*), intent(in) :: filename ! name of file to be opened - character(*), intent(in) :: fh_str ! parallel or serial HDF5 file - character(*), intent(in) :: mode ! open mode 'r' read, 'rw' read/write + 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 :: proc_open = 0 ! processor to open file (default is master) #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 (master) call hdf5_file_open(filename, hdf5_fh, mode) + if (rank == proc_open) call hdf5_file_open(filename, hdf5_fh, mode) else call hdf5_parallel_file_open(filename, hdf5_fh, mode) endif @@ -108,15 +120,21 @@ contains ! FILE_CLOSE closes a file !=============================================================================== - subroutine file_close(fh_str) + subroutine file_close(fh_str, proc_id) - character(*), intent(in) :: fh_str ! serial or parallel hdf5 file + 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 #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(master) call hdf5_file_close(hdf5_fh) + if(rank == proc_close) call hdf5_file_close(hdf5_fh) else call hdf5_file_close(hdf5_fh) endif From 51a245bcf1ed3285a514cef419cf79a4331b0d91 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 14:05:32 -0400 Subject: [PATCH 37/65] removed extra variables that are now in hdf5_interface --- src/particle_restart.F90 | 2 -- src/particle_restart_write.F90 | 1 - 2 files changed, 3 deletions(-) diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index 20da7f9987..9d21f7c70f 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -38,8 +38,6 @@ contains subroutine read_hdf5_particle_restart() - integer(HSIZE_T) :: dims1(1) - ! write meessage message = "Loading particle restart file " // trim(path_particle_restart) & // "..." diff --git a/src/particle_restart_write.F90 b/src/particle_restart_write.F90 index 7724fd0358..ff59b0a1b0 100644 --- a/src/particle_restart_write.F90 +++ b/src/particle_restart_write.F90 @@ -47,7 +47,6 @@ contains subroutine write_particle_restart_hdf5() character(MAX_FILE_LEN) :: filename - integer(HSIZE_T) :: dims1(1) type(Bank), pointer :: src => null() ! set up file name From a4b2038d1fb23102b6a0c61e08cc021e858d19ea Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 14:05:46 -0400 Subject: [PATCH 38/65] global now depends on hdf5_interface --- src/DEPENDENCIES | 1 + 1 file changed, 1 insertion(+) diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index 947b6fdacf..d1fc46d3a9 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -162,6 +162,7 @@ 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 From 1c4c6638b6a515b1b4bfa9abbecb0164278a1a42 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Fri, 17 May 2013 14:37:19 -0400 Subject: [PATCH 39/65] removed HDF5 group for timing --- src/hdf5_summary.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/hdf5_summary.F90 b/src/hdf5_summary.F90 index 9e90c9f230..3963b0035b 100644 --- a/src/hdf5_summary.F90 +++ b/src/hdf5_summary.F90 @@ -646,7 +646,6 @@ contains subroutine hdf5_write_timing() - integer(HID_T) :: timing_group integer(8) :: total_particles real(8) :: speed From c0b0a8114559a1848ce6c28dd2b50892c5727bbf Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Tue, 14 May 2013 19:47:06 -0400 Subject: [PATCH 40/65] Introduced overall_gen global variable. --- src/eigenvalue.F90 | 3 +++ src/global.F90 | 5 +++-- src/source.F90 | 3 +-- 3 files changed, 7 insertions(+), 4 deletions(-) diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index 61e9144764..1747de4e70 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -143,6 +143,9 @@ contains subroutine initialize_generation() + ! set overall generation number + overall_gen = gen_per_batch*(current_batch - 1) + current_gen + ! Reset number of fission bank sites n_bank = 0 diff --git a/src/global.F90 b/src/global.F90 index 9a64a7bce0..f48f1391c4 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -156,7 +156,8 @@ module global integer :: n_active ! # of active batches integer :: gen_per_batch = 1 ! # of generations per batch integer :: current_batch = 0 ! current batch - integer :: current_gen = 0 ! current generation + integer :: current_gen = 0 ! current generation within a batch + integer :: overall_gen = 0 ! overall generation in the run ! External source type(ExtSource), target :: external_source @@ -182,7 +183,7 @@ module global ! Shannon entropy logical :: entropy_on = .false. - real(8), allocatable :: entropy(:) ! shannon entropy at each batch + real(8), allocatable :: entropy(:) ! shannon entropy at each generation real(8), allocatable :: entropy_p(:,:,:,:) ! % of source sites in each cell type(StructuredMesh), pointer :: entropy_mesh diff --git a/src/source.F90 b/src/source.F90 index ab115615ab..9ffea50089 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -167,8 +167,7 @@ contains p % id = bank_first + index_source - 1 ! set random number seed - particle_seed = ((current_batch - 1)*gen_per_batch + & - current_gen - 1)*n_particles + p % id + particle_seed = (overall_gen - 1)*n_particles + p % id call set_particle_seed(particle_seed) ! set particle trace From cbdff6203423398c5db388f56c613c59c3ac2e80 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 18 May 2013 02:09:04 -0400 Subject: [PATCH 41/65] Calculate keff at each generation now. Need to check statepoints. --- src/eigenvalue.F90 | 137 ++++++++++++++++++++------------------------ src/global.F90 | 2 +- src/input_xml.F90 | 2 +- src/output.F90 | 22 ++++--- src/state_point.F90 | 12 ++-- src/tally.F90 | 6 -- 6 files changed, 86 insertions(+), 95 deletions(-) diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index 1747de4e70..b4a7eb122b 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -25,6 +25,9 @@ module eigenvalue private public :: run_eigenvalue + ! Single-generation k on each processor + real(8) :: keff_generation + contains !=============================================================================== @@ -81,16 +84,7 @@ contains ! Accumulate time for transport call time_transport % stop() - ! Distribute fission bank across processors evenly - call time_bank % start() - call synchronize_bank() - call time_bank % stop() - - ! Calculate shannon entropy - if (entropy_on) call shannon_entropy() - - ! Write generation output - if (master .and. current_gen /= gen_per_batch) call print_generation() + call finalize_generation() end do GENERATION_LOOP @@ -152,8 +146,33 @@ contains ! Count source sites if using uniform fission source weighting if (ufs) call count_source_for_ufs() + ! Store current value of tracklength k + keff_generation = global_tallies(K_TRACKLENGTH) % value + end subroutine initialize_generation +!=============================================================================== +! FINALIZE_GENERATION +!=============================================================================== + + subroutine finalize_generation() + + ! Distribute fission bank across processors evenly + call time_bank % start() + call synchronize_bank() + call time_bank % stop() + + ! Calculate shannon entropy + if (entropy_on) call shannon_entropy() + + ! Collect results and statistics + call calculate_keff() + + ! Write generation output + if (master .and. current_gen /= gen_per_batch) call print_generation() + + end subroutine finalize_generation + !=============================================================================== ! FINALIZE_BATCH handles synchronization and accumulation of tallies, ! calculation of Shannon entropy, getting single-batch estimate of keff, and @@ -167,8 +186,11 @@ contains call synchronize_tallies() call time_tallies % stop() - ! Collect results and statistics - call calculate_keff() + ! Reset global tally results + if (.not. active_batches) then + call reset_result(global_tallies) + n_realizations = 0 + end if ! Perform CMFD calculation if on if (cmfd_on) call execute_cmfd() @@ -183,7 +205,6 @@ contains ! Create state point file call write_state_point() - end if if (master .and. current_batch == n_batches) then @@ -544,77 +565,52 @@ contains subroutine calculate_keff() - real(8) :: temp(2) ! used to reduce sum and sum_sq - real(8) :: alpha ! significance level for CI - real(8) :: t_value ! t-value for confidence intervals + integer :: n ! number of active generations + real(8) :: alpha ! significance level for CI + real(8) :: t_value ! t-value for confidence intervals + real(8), save :: k_sum(2) = ZERO ! used to reduce sum and sum_sq - message = "Calculate batch keff..." + message = "Calculate generation keff..." call write_message(8) ! ========================================================================= - ! SINGLE-BATCH ESTIMATE OF K-EFFECTIVE + ! SINGLE GENERATION ESTIMATE OF K-EFFECTIVE + + ! Get keff for this generation by subtracting off the starting value + keff_generation = global_tallies(K_TRACKLENGTH) % value - keff_generation #ifdef MPI - if (.not. reduce_tallies) then - ! Reduce value of k_batch if running in parallel - if (master) then - call MPI_REDUCE(MPI_IN_PLACE, k_batch(current_batch), 1, MPI_REAL8, & - MPI_SUM, 0, MPI_COMM_WORLD, mpi_err) - else - ! Receive buffer not significant at other processors - call MPI_REDUCE(k_batch(current_batch), temp, 1, MPI_REAL8, & - MPI_SUM, 0, MPI_COMM_WORLD, mpi_err) - end if - end if + ! Combine values across all processors + call MPI_REDUCE(keff_generation, k_generation(overall_gen), 1, MPI_REAL8, & + MPI_SUM, 0, MPI_COMM_WORLD, mpi_err) +#else + k_generation(overall_gen) = keff_generation #endif ! Normalize single batch estimate of k - if (master) then - k_batch(current_batch) = k_batch(current_batch) / & - (n_particles * gen_per_batch) - end if + if (master) k_generation(overall_gen) = & + k_generation(overall_gen) / n_particles ! ========================================================================= ! ACCUMULATED K-EFFECTIVE AND ITS VARIANCE - if (reduce_tallies) then - ! In this case, global_tallies has already been reduced, so we don't - ! need to perform any more reductions and just take the values from - ! global_tallies directly + ! Determine number of active generations + n = overall_gen - n_inactive*gen_per_batch - ! Sample mean of keff - keff = global_tallies(K_TRACKLENGTH) % sum / n_realizations + if (n <= 0) then + ! For inactive generations, use current generation k as estimate for next + ! generation + keff = k_generation(overall_gen) - if (n_realizations > 1) then - if (confidence_intervals) then - ! Calculate t-value for confidence intervals - alpha = ONE - CONFIDENCE_LEVEL - t_value = t_percentile(ONE - alpha/TWO, n_realizations - 1) - else - t_value = ONE - end if - - ! Standard deviation of the sample mean of k - keff_std = t_value * sqrt((global_tallies(K_TRACKLENGTH) % sum_sq / & - n_realizations - keff * keff) / (n_realizations - 1)) - end if else - ! In this case, no reduce was ever done on global_tallies. Thus, we need - ! to reduce the values in sum and sum^2 to get the sample mean and its - ! standard deviation + ! Sample mean of keff + k_sum(1) = k_sum(1) + k_generation(overall_gen) + k_sum(2) = k_sum(2) + k_generation(overall_gen)**2 -#ifdef MPI - call MPI_REDUCE(global_tallies(K_TRACKLENGTH) % sum, temp, 2, & - MPI_REAL8, MPI_SUM, 0, MPI_COMM_WORLD, mpi_err) -#else - temp(1) = global_tallies(K_TRACKLENGTH) % sum - temp(2) = global_tallies(K_TRACKLENGTH) % sum_sq -#endif + ! Determine mean + keff = k_sum(1) / n - ! Sample mean of k - keff = temp(1) / n_realizations - - if (n_realizations > 1) then + if (n > 1) then if (confidence_intervals) then ! Calculate t-value for confidence intervals alpha = ONE - CONFIDENCE_LEVEL @@ -624,8 +620,7 @@ contains end if ! Standard deviation of the sample mean of k - keff_std = t_value * sqrt((temp(2)/n_realizations - keff*keff) / & - (n_realizations - 1)) + keff_std = t_value * sqrt((k_sum(2)/n - keff**2) / (n - 1)) end if end if @@ -634,12 +629,6 @@ contains call MPI_BCAST(keff, 1, MPI_REAL8, 0, MPI_COMM_WORLD, mpi_err) #endif - ! Reset global tally results - if (.not. active_batches) then - call reset_result(global_tallies) - n_realizations = 0 - end if - end subroutine calculate_keff !=============================================================================== diff --git a/src/global.F90 b/src/global.F90 index f48f1391c4..5597ae2dfb 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -173,7 +173,7 @@ module global integer(8) :: current_work ! index in source bank of current history simulated ! Temporary k-effective values - real(8), allocatable :: k_batch(:) ! batch estimates of k + real(8), allocatable :: k_generation(:) ! single-generation estimates of k real(8) :: keff = ONE ! average k over active batches real(8) :: keff_std ! standard deviation of average k real(8) :: k_col_abs = ZERO ! sum over batches of k_collision * k_absorption diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 75d0518d1f..a9b62d4905 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -148,7 +148,7 @@ contains gen_per_batch = eigenvalue_ % generations_per_batch ! Allocate array for batch keff and entropy - allocate(k_batch(n_batches)) + allocate(k_generation(n_batches*gen_per_batch)) allocate(entropy(n_batches*gen_per_batch)) entropy = ZERO end if diff --git a/src/output.F90 b/src/output.F90 index 4ca455624b..1ccd434a8a 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -1215,24 +1215,24 @@ contains if (entropy_on) then if (cmfd_run) then - message = " Bat./Gen. k(batch) Entropy Average k CMFD k CMFD Ent" + message = " Bat./Gen. keff Entropy Average k CMFD k CMFD Ent" call write_message(1) message = " ========= ======== ======== ==================== ======== ========" call write_message(1) else - message = " Bat./Gen. k(batch) Entropy Average k" + message = " Bat./Gen. keff Entropy Average k" call write_message(1) message = " ========= ======== ======== ====================" call write_message(1) end if else if (cmfd_run) then - message = " Bat./Gen. k(batch) Average k CMFD k" + message = " Bat./Gen. keff Average k CMFD k" call write_message(1) message = " ========= ======== ==================== ========" call write_message(1) else - message = " Bat./Gen. k(batch) Average k" + message = " Bat./Gen. keff Average k" call write_message(1) message = " ========= ======== ====================" call write_message(1) @@ -1251,11 +1251,17 @@ contains ! write out information about batch and generation write(UNIT=OUTPUT_UNIT, FMT='(2X,A9)', ADVANCE='NO') & trim(to_str(current_batch)) // "/" // trim(to_str(current_gen)) - write(UNIT=OUTPUT_UNIT, FMT='(11X)', ADVANCE='NO') + write(UNIT=OUTPUT_UNIT, FMT='(3X,F8.5)', ADVANCE='NO') & + k_generation(overall_gen) ! write out entropy info if (entropy_on) write(UNIT=OUTPUT_UNIT, FMT='(3X, F8.5)', ADVANCE='NO') & - entropy(current_gen + gen_per_batch*(current_batch - 1)) + entropy(overall_gen) + + if (overall_gen - n_inactive*gen_per_batch > 1) then + write(UNIT=OUTPUT_UNIT, FMT='(3X, F8.5," +/-",F8.5)', ADVANCE='NO') & + keff, keff_std + end if ! next line write(UNIT=OUTPUT_UNIT, FMT=*) @@ -1273,14 +1279,14 @@ contains write(UNIT=OUTPUT_UNIT, FMT='(2X,A9)', ADVANCE='NO') & trim(to_str(current_batch)) // "/" // trim(to_str(gen_per_batch)) write(UNIT=OUTPUT_UNIT, FMT='(3X,F8.5)', ADVANCE='NO') & - k_batch(current_batch) + k_generation(overall_gen) ! write out entropy info if (entropy_on) write(UNIT=OUTPUT_UNIT, FMT='(3X, F8.5)', ADVANCE='NO') & entropy(current_batch*gen_per_batch) ! write out accumulated k-effective if after first active batch - if (current_batch > n_inactive + 1) then + if (overall_gen - n_inactive*gen_per_batch > 1) then write(UNIT=OUTPUT_UNIT, FMT='(3X, F8.5," +/-",F8.5)', ADVANCE='NO') & keff, keff_std else diff --git a/src/state_point.F90 b/src/state_point.F90 index e11ea72fc9..fd0a085084 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -86,7 +86,8 @@ contains 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_batch, "k_batch", length=current_batch) + call 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") @@ -363,7 +364,8 @@ contains if (run_mode == MODE_EIGENVALUE) then call read_data(int_array(1), "n_inactive") call read_data(gen_per_batch, "gen_per_batch") - call read_data(k_batch, "k_batch", length=restart_batch) + call read_data(k_generation, "k_generation", & + length=restart_batch*gen_per_batch) call read_data(entropy, "entropy", length=restart_batch*gen_per_batch) call read_data(k_col_abs, "k_col_abs") call read_data(k_col_tra, "k_col_tra") @@ -592,8 +594,8 @@ contains if (current_batch > n_inactive) then n = n + 1 - temp(1) = temp(1) + k_batch(current_batch) - temp(2) = temp(2) + k_batch(current_batch)*k_batch(current_batch) + temp(1) = temp(1) + k_generation(overall_gen) + temp(2) = temp(2) + k_generation(overall_gen)**2 ! calculate mean keff keff = temp(1) / n @@ -610,7 +612,7 @@ contains keff_std = t_value * sqrt((temp(2)/n - keff*keff)/(n - 1)) end if else - keff = k_batch(current_batch) + keff = k_generation(overall_gen) end if ! print out batch keff diff --git a/src/tally.F90 b/src/tally.F90 index 3aa3e34855..b7b55189ad 100644 --- a/src/tally.F90 +++ b/src/tally.F90 @@ -1757,12 +1757,6 @@ contains end do if (run_mode == MODE_EIGENVALUE) then - ! Get the current batch estimate of k_analog for displaying to output - ! --- this has to be performed after reduce_tally_values and before - ! accumulate_result - - k_batch(current_batch) = global_tallies(K_TRACKLENGTH) % value - if (active_batches) then ! Accumulate products of different estimators of k k_col = global_tallies(K_COLLISION) % value / total_weight From 56a0ca4c8553cc31345939011c2614023743b753 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 18 May 2013 13:58:50 -0400 Subject: [PATCH 42/65] Fix replay_batch_history with k-generation. --- src/DEPENDENCIES | 3 +- src/Makefile | 2 +- src/eigenvalue.F90 | 78 +++++++++++++++++++++++++++++++++------------ src/state_point.F90 | 57 +-------------------------------- 4 files changed, 60 insertions(+), 80 deletions(-) diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index d1fc46d3a9..0899a78bd7 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -341,11 +341,10 @@ source.o: string.o state_point.o: error.o state_point.o: global.o -state_point.o: math.o state_point.o: output.o +state_point.o: output_interface.o state_point.o: string.o state_point.o: tally_header.o -state_point.o: output_interface.o string.o: constants.o string.o: error.o diff --git a/src/Makefile b/src/Makefile index 11cd3a3899..36d87875b3 100644 --- a/src/Makefile +++ b/src/Makefile @@ -29,7 +29,7 @@ PETSC = no #=============================================================================== MPI_DIR = /opt/mpich/3.0.2-$(COMPILER) -HDF5_DIR = /opt/hdf5/1.8.10-patch1-$(COMPILER) +HDF5_DIR = /opt/phdf5/1.8.10-patch1-$(COMPILER) PETSC_DIR = /opt/petsc/3.3-p6-$(COMPILER) #=============================================================================== diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index b4a7eb122b..f8e56fcaf9 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -17,7 +17,7 @@ module eigenvalue use random_lcg, only: prn, set_particle_seed, prn_skip use search, only: binary_search use source, only: get_source_particle - use state_point, only: write_state_point, replay_batch_history + use state_point, only: write_state_point use string, only: to_str use tally, only: synchronize_tallies, setup_active_usertallies, & reset_result @@ -25,8 +25,8 @@ module eigenvalue private public :: run_eigenvalue - ! Single-generation k on each processor - real(8) :: keff_generation + real(8) :: keff_generation ! Single-generation k on each processor + real(8) :: k_sum(2) = ZERO ! used to reduce sum and sum_sq contains @@ -166,7 +166,8 @@ contains if (entropy_on) call shannon_entropy() ! Collect results and statistics - call calculate_keff() + call calculate_generation_keff() + call calculate_average_keff() ! Write generation output if (master .and. current_gen /= gen_per_batch) call print_generation() @@ -559,22 +560,12 @@ contains end subroutine shannon_entropy !=============================================================================== -! CALCULATE_KEFF calculates the single batch estimate of keff as well as the -! mean and standard deviation of the mean for active batches +! CALCULATE_GENERATION_KEFF collects the single-processor tracklength k's onto +! the master processor and normalizes them. This should work whether or not the +! no-reduce method is being used. !=============================================================================== - subroutine calculate_keff() - - integer :: n ! number of active generations - real(8) :: alpha ! significance level for CI - real(8) :: t_value ! t-value for confidence intervals - real(8), save :: k_sum(2) = ZERO ! used to reduce sum and sum_sq - - message = "Calculate generation keff..." - call write_message(8) - - ! ========================================================================= - ! SINGLE GENERATION ESTIMATE OF K-EFFECTIVE + subroutine calculate_generation_keff() ! Get keff for this generation by subtracting off the starting value keff_generation = global_tallies(K_TRACKLENGTH) % value - keff_generation @@ -588,11 +579,23 @@ contains #endif ! Normalize single batch estimate of k + ! TODO: This should be normalized by total_weight, not by n_particles if (master) k_generation(overall_gen) = & k_generation(overall_gen) / n_particles - ! ========================================================================= - ! ACCUMULATED K-EFFECTIVE AND ITS VARIANCE + end subroutine calculate_generation_keff + +!=============================================================================== +! CALCULATE_AVERAGE_KEFF calculates the mean and standard deviation of the mean +! of k-effective during active generations and broadcasts the mean to all +! processors +!=============================================================================== + + subroutine calculate_average_keff() + + integer :: n ! number of active generations + real(8) :: alpha ! significance level for CI + real(8) :: t_value ! t-value for confidence intervals ! Determine number of active generations n = overall_gen - n_inactive*gen_per_batch @@ -629,7 +632,7 @@ contains call MPI_BCAST(keff, 1, MPI_REAL8, 0, MPI_COMM_WORLD, mpi_err) #endif - end subroutine calculate_keff + end subroutine calculate_average_keff !=============================================================================== ! CALCULATE_COMBINED_KEFF calculates a minimum variance estimate of k-effective @@ -778,4 +781,37 @@ contains end subroutine count_source_for_ufs +!=============================================================================== +! REPLAY_BATCH_HISTORY displays keff and entropy for each generation within a +! batch using data read from a state point file +!=============================================================================== + + subroutine replay_batch_history + + ! Write message at beginning + if (current_batch == 1) then + message = "Replaying history from state point..." + call write_message(1) + end if + + do current_gen = 1, gen_per_batch + overall_gen = overall_gen + 1 + call calculate_average_keff() + + ! print out batch keff + if (current_gen < gen_per_batch) then + if (master) call print_generation() + else + if (master) call print_batch_keff() + end if + end do + + ! Write message at end + if (current_batch == restart_batch) then + message = "Resuming simulation..." + call write_message(1) + end if + + end subroutine replay_batch_history + end module eigenvalue diff --git a/src/state_point.F90 b/src/state_point.F90 index fd0a085084..ec7a060fc4 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -15,8 +15,7 @@ module state_point use constants use error, only: fatal_error, warning use global - use output, only: write_message, time_stamp, print_batch_keff - use math, only: t_percentile + use output, only: write_message, time_stamp use string, only: to_str use output_interface use tally_header, only: TallyObject @@ -572,60 +571,6 @@ contains end subroutine load_state_point -!=============================================================================== -! REPLAY_BATCH_HISTORY displays batch keff and entropy for each batch stored in -! a state point file -!=============================================================================== - - subroutine replay_batch_history - - integer :: n = 0 ! number of realizations - real(8), save :: temp(2) = ZERO ! temporary values for keff - real(8) :: alpha ! significance level for CI - real(8) :: t_value ! t-value for confidence intervals - - ! Write message at beginning - if (current_batch == 1) then - message = "Replaying history from state point..." - call write_message(1) - end if - - ! Add to number of realizations - if (current_batch > n_inactive) then - n = n + 1 - - temp(1) = temp(1) + k_generation(overall_gen) - temp(2) = temp(2) + k_generation(overall_gen)**2 - - ! calculate mean keff - keff = temp(1) / n - - if (n > 1) then - if (confidence_intervals) then - ! Calculate t-value for confidence intervals - alpha = ONE - CONFIDENCE_LEVEL - t_value = t_percentile(ONE - alpha/TWO, n - 1) - else - t_value = ONE - end if - - keff_std = t_value * sqrt((temp(2)/n - keff*keff)/(n - 1)) - end if - else - keff = k_generation(overall_gen) - end if - - ! print out batch keff - if (master) call print_batch_keff() - - ! Write message at end - if (current_batch == restart_batch) then - message = "Resuming simulation..." - call write_message(1) - end if - - end subroutine replay_batch_history - subroutine read_source ! TODO write this routine ! TODO what if n_particles does not match source bank From 9611aff76b079edc0207e22af641b0b8902f55f1 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 18 May 2013 14:01:27 -0400 Subject: [PATCH 43/65] Change column header for k. --- src/output.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/output.F90 b/src/output.F90 index 1ccd434a8a..01e714f8a1 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -1215,24 +1215,24 @@ contains if (entropy_on) then if (cmfd_run) then - message = " Bat./Gen. keff Entropy Average k CMFD k CMFD Ent" + message = " Bat./Gen. k Entropy Average k CMFD k CMFD Ent" call write_message(1) message = " ========= ======== ======== ==================== ======== ========" call write_message(1) else - message = " Bat./Gen. keff Entropy Average k" + message = " Bat./Gen. k Entropy Average k" call write_message(1) message = " ========= ======== ======== ====================" call write_message(1) end if else if (cmfd_run) then - message = " Bat./Gen. keff Average k CMFD k" + message = " Bat./Gen. k Average k CMFD k" call write_message(1) message = " ========= ======== ==================== ========" call write_message(1) else - message = " Bat./Gen. keff Average k" + message = " Bat./Gen. k Average k" call write_message(1) message = " ========= ======== ====================" call write_message(1) From b95fa9b583452736d8c269486de44dbc029c4ab4 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 18 May 2013 14:09:46 -0400 Subject: [PATCH 44/65] Increment statepoint revision since k is now stored for each generation. --- src/constants.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/constants.F90 b/src/constants.F90 index 8e2d0b4e3b..0772f8dea6 100644 --- a/src/constants.F90 +++ b/src/constants.F90 @@ -12,7 +12,7 @@ module constants ! Revision numbers for binary files integer, parameter :: REVISION_SOURCE = 1 - integer, parameter :: REVISION_STATEPOINT = 8 + integer, parameter :: REVISION_STATEPOINT = 9 ! ============================================================================ ! ADJUSTABLE PARAMETERS From c0def2d533e037b9d44493061e8b992c4d0f86b3 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 18 May 2013 23:53:26 -0400 Subject: [PATCH 45/65] Added header to statepoint/particle restart files. Combined command line options -r and -s. --- src/constants.F90 | 9 +++++++-- src/initialize.F90 | 26 ++++++++++++++++++-------- src/output.F90 | 4 ++-- src/particle_restart.F90 | 5 +++++ src/particle_restart_write.F90 | 6 ++++++ src/state_point.F90 | 9 +++++++-- 6 files changed, 45 insertions(+), 14 deletions(-) diff --git a/src/constants.F90 b/src/constants.F90 index 0772f8dea6..4442d05ca1 100644 --- a/src/constants.F90 +++ b/src/constants.F90 @@ -11,8 +11,13 @@ module constants integer, parameter :: VERSION_RELEASE = 1 ! Revision numbers for binary files - integer, parameter :: REVISION_SOURCE = 1 - integer, parameter :: REVISION_STATEPOINT = 9 + integer, parameter :: REVISION_STATEPOINT = 9 + integer, parameter :: REVISION_PARTICLE_RESTART = 1 + + ! Binary file types + integer, parameter :: & + FILETYPE_STATEPOINT = -1, & + FILETYPE_PARTICLE_RESTART = -2 ! ============================================================================ ! ADJUSTABLE PARAMETERS diff --git a/src/initialize.F90 b/src/initialize.F90 index 73c05a66c9..c6c8dd1399 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -13,6 +13,7 @@ module initialize cells_in_univ_dict, read_plots_xml use output, only: title, header, write_summary, print_version, & print_usage, write_xs_summary, print_plot + use output_interface, only: file_open, file_close, read_data use random_lcg, only: initialize_prng use source, only: initialize_source use state_point, only: load_state_point @@ -290,6 +291,7 @@ contains integer :: i ! loop index integer :: argc ! number of command line arguments integer :: last_flag ! index of last flag + integer :: filetype character(MAX_FILE_LEN) :: pwd ! present working directory character(MAX_WORD_LEN), allocatable :: argv(:) ! command line arguments @@ -326,10 +328,23 @@ contains call fatal_error() end if case ('-r', '-restart', '--restart') - ! Read path for state point + ! Read path for state point/particle restart i = i + 1 - path_state_point = argv(i) - restart_run = .true. + + ! Check what type of file this is + call file_open(argv(i), 'serial', 'r') + call read_data(filetype, 'filetype') + call file_close('serial') + + ! Set path and flag for type of run + select case (filetype) + case (FILETYPE_STATEPOINT) + path_state_point = argv(i) + restart_run = .true. + case (FILETYPE_PARTICLE_RESTART) + path_particle_restart = argv(i) + particle_restart_run = .true. + end select case ('-t', '-tallies', '--tallies') run_mode = MODE_TALLIES @@ -348,11 +363,6 @@ contains case ('-eps_tol', '-ksp_gmres_restart') ! Handle options that would be based to PETSC i = i + 1 - case ('-s','-particle','--particle') - ! Read in path for particle restart - i = i + 1 - path_particle_restart = argv(i) - particle_restart_run = .true. case default message = "Unknown command line option: " // argv(i) call fatal_error() diff --git a/src/output.F90 b/src/output.F90 index 01e714f8a1..b8302226d7 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -166,8 +166,8 @@ contains write(OUTPUT_UNIT,*) write(OUTPUT_UNIT,*) 'Options:' write(OUTPUT_UNIT,*) ' -p, --plot Run in plotting mode' - write(OUTPUT_UNIT,*) ' -r, --restart Restart a previous run' - write(OUTPUT_UNIT,*) ' -s, --particle Run a single particle history' + 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, --tallies Write tally results from state point' write(OUTPUT_UNIT,*) ' -v, --version Show version information' write(OUTPUT_UNIT,*) ' -?, --help Show this message' diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index 9d21f7c70f..042a64755e 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -79,6 +79,9 @@ contains subroutine read_binary_particle_restart() + integer :: filetype + integer :: revision + ! write meessage message = "Loading particle restart file " // trim(path_particle_restart) & // "..." @@ -89,6 +92,8 @@ contains 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 diff --git a/src/particle_restart_write.F90 b/src/particle_restart_write.F90 index ff59b0a1b0..12cd17c34b 100644 --- a/src/particle_restart_write.F90 +++ b/src/particle_restart_write.F90 @@ -60,6 +60,10 @@ contains 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) @@ -101,6 +105,8 @@ contains 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 diff --git a/src/state_point.F90 b/src/state_point.F90 index ec7a060fc4..b9b62bb9e9 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -55,9 +55,11 @@ contains call file_create(filename, 'serial') if (master) then + ! Write file type + call write_data(FILETYPE_STATEPOINT, "filetype") ! Write revision number for state point file - call write_data(REVISION_STATEPOINT, "revision_statepoint") + call write_data(REVISION_STATEPOINT, "revision") ! Write OpenMC version call write_data(VERSION_MAJOR, "version_major") @@ -319,9 +321,12 @@ contains ! Open file for reading call file_open(path_state_point, 'parallel', 'r') + ! Read filetype + call 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_statepoint") + call read_data(int_array(1), "revision") if (int_array(1) /= REVISION_STATEPOINT) then message = "State point version does not match current version " & // "in OpenMC." From 9f0ee111aaa1f6d9a6dd70359a2982c920b16c92 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 18 May 2013 23:59:33 -0400 Subject: [PATCH 46/65] Use print_particle for particle restarts. --- src/particle_restart.F90 | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index 042a64755e..7c732800fa 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -7,7 +7,7 @@ module particle_restart use geometry_header, only: BASE_UNIVERSE use global use particle_header, only: deallocate_coord - use output, only: write_message + use output, only: write_message, print_particle use physics, only: transport use random_lcg, only: set_particle_seed use source, only: initialize_particle @@ -145,11 +145,7 @@ contains call transport() ! write output if particle made it - write(ou,*) 'Particle Successfully Transport:' - write(ou,*) 'WEIGHT:', p % wgt - write(ou,*) 'ENERGY:', p % E - write(ou,*) 'LOCATION:', p % coord % xyz - write(ou,*) 'ANGLE:', p % coord % uvw + call print_particle() end subroutine run_particle_restart From e2f0bb7bcf18bf62eb6908426f36f75e3c94d38a Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 18 May 2013 23:59:41 -0400 Subject: [PATCH 47/65] Change back hdf5 in Makefile. --- src/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Makefile b/src/Makefile index 36d87875b3..11cd3a3899 100644 --- a/src/Makefile +++ b/src/Makefile @@ -29,7 +29,7 @@ PETSC = no #=============================================================================== MPI_DIR = /opt/mpich/3.0.2-$(COMPILER) -HDF5_DIR = /opt/phdf5/1.8.10-patch1-$(COMPILER) +HDF5_DIR = /opt/hdf5/1.8.10-patch1-$(COMPILER) PETSC_DIR = /opt/petsc/3.3-p6-$(COMPILER) #=============================================================================== From ca3c4c88e5b102156f607ea0d36c84ee8881202a Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Mon, 20 May 2013 10:35:08 -0400 Subject: [PATCH 48/65] changed action from write to readwrite --- 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 2560c36575..e28651f51e 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -106,7 +106,7 @@ contains #else ! Check for read/write mode to open, default is read only if (mode == 'rw') then - open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION='write', & + open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION='readwrite', & STATUS='old', ACCESS='stream') else open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION='read', & From 7babdb50a6716f627050f993954b6916ea5793a4 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Mon, 20 May 2013 10:43:56 -0400 Subject: [PATCH 49/65] changed mpi_interface to mpiio_interface and decoupled it from constants and global modules --- src/DEPENDENCIES | 4 +--- src/OBJECTS | 2 +- src/{mpi_interface.F90 => mpiio_interface.F90} | 12 ++++-------- src/output_interface.F90 | 2 +- 4 files changed, 7 insertions(+), 13 deletions(-) rename src/{mpi_interface.F90 => mpiio_interface.F90} (97%) diff --git a/src/DEPENDENCIES b/src/DEPENDENCIES index d1fc46d3a9..55cbebc474 100644 --- a/src/DEPENDENCIES +++ b/src/DEPENDENCIES @@ -249,8 +249,6 @@ mesh.o: mesh_header.o mesh.o: particle_header.o mesh.o: search.o -mpi_interface.o: constants.o - output.o: ace_header.o output.o: constants.o output.o: endf.o @@ -265,7 +263,7 @@ output.o: string.o output.o: tally_header.o output_interface.o: hdf5_interface.o -output_interface.o: mpi_interface.o +output_interface.o: mpiio_interface.o particle_header.o: constants.o diff --git a/src/OBJECTS b/src/OBJECTS index f40b1250cb..b079906751 100644 --- a/src/OBJECTS +++ b/src/OBJECTS @@ -39,7 +39,7 @@ material_header.o \ math.o \ mesh_header.o \ mesh.o \ -mpi_interface.o \ +mpiio_interface.o \ output.o \ output_interface.o \ particle_header.o \ diff --git a/src/mpi_interface.F90 b/src/mpiio_interface.F90 similarity index 97% rename from src/mpi_interface.F90 rename to src/mpiio_interface.F90 index 871b5f55cc..36d453b359 100644 --- a/src/mpi_interface.F90 +++ b/src/mpiio_interface.F90 @@ -1,16 +1,12 @@ -module mpi_interface - - use constants - use global +module mpiio_interface #ifdef MPI use mpi implicit none - integer :: mpi_fh ! MPI file handle - - ! TODO: eventually move mpi_err to here and use this for all other MPI calls + integer :: mpi_fh ! MPI file handle + integer :: mpi_err ! MPI error code contains @@ -240,4 +236,4 @@ contains end subroutine mpi_read_string #endif -end module mpi_interface +end module mpiio_interface diff --git a/src/output_interface.F90 b/src/output_interface.F90 index e28651f51e..f3db2d0e77 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -8,7 +8,7 @@ module output_interface #ifdef HDF5 use hdf5_interface #elif MPI - use mpi_interface + use mpiio_interface #endif implicit none From 39ebf27a6e9235cb40be9cb9a18a9b1d9255191c Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 21 May 2013 08:46:30 -0400 Subject: [PATCH 50/65] added back in the no_reduce option for tally accumulation for statepoint writing --- src/state_point.F90 | 109 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 108 insertions(+), 1 deletion(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index e11ea72fc9..1278719bb2 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -205,7 +205,7 @@ contains ! Check for the no-tally-reduction method if (.not. reduce_tallies) then - ! TODO Call the no tally reduce routine + call write_tally_results_nr() elseif (master) then @@ -296,6 +296,113 @@ contains end subroutine write_state_point +!=============================================================================== +! WRITE_TALLY_RESULTS_NR +!=============================================================================== + + subroutine write_tally_results_nr() + + integer :: i ! loop index + integer :: n ! number of filter bins + integer :: m ! number of score bins + integer :: n_bins ! total number of bins + real(8), allocatable :: tally_temp(:,:,:) ! contiguous array of results + real(8) :: global_temp(2,N_GLOBAL_TALLIES) + real(8) :: dummy ! temporary receive buffer for non-root reduces + type(TallyObject), pointer :: t => null() + + ! ========================================================================== + ! COLLECT AND WRITE GLOBAL TALLIES + + if (master) then + ! Write number of realizations + call write_data(n_realizations, "n_realizations") + + ! Write number of global tallies + call write_data(N_GLOBAL_TALLIES, "n_global_tallies") + end if + + ! Copy global tallies into temporary array for reducing + n_bins = 2 * N_GLOBAL_TALLIES + global_temp(1,:) = global_tallies(:) % sum + global_temp(2,:) = global_tallies(:) % sum_sq + + if (master) then + ! The MPI_IN_PLACE specifier allows the master to copy values into a + ! receive buffer without having a temporary variable + call MPI_REDUCE(MPI_IN_PLACE, global_temp, n_bins, MPI_REAL8, MPI_SUM, & + 0, MPI_COMM_WORLD, mpi_err) + + ! Transfer values to value on master + if (current_batch == n_batches) then + global_tallies(:) % sum = global_temp(1,:) + global_tallies(:) % sum_sq = global_temp(2,:) + end if + + ! Write out global tallies sum and sum_sq + call write_tally_result(global_tallies, "global_tallies", & + n1=N_GLOBAL_TALLIES, n2=1) + else + ! Receive buffer not significant at other processors + call MPI_REDUCE(global_temp, dummy, n_bins, MPI_REAL8, MPI_SUM, & + 0, MPI_COMM_WORLD, mpi_err) + end if + + if (tallies_on) then + ! Indicate that tallies are on + if (master) then + call write_data(1, "tallies_present", group="tallies") + end if + + ! Write all tally results + TALLY_RESULTS: do i = 1, n_tallies + t => tallies(i) + + ! Determine size of tally results array + m = size(t % results, 1) + n = size(t % results, 2) + n_bins = m*n*2 + + ! Allocate array for storing sums and sums of squares, but + ! contiguously in memory for each + allocate(tally_temp(2,m,n)) + tally_temp(1,:,:) = t % results(:,:) % sum + tally_temp(2,:,:) = t % results(:,:) % sum_sq + + if (master) then + ! The MPI_IN_PLACE specifier allows the master to copy values into + ! a receive buffer without having a temporary variable + call MPI_REDUCE(MPI_IN_PLACE, tally_temp, n_bins, MPI_REAL8, & + MPI_SUM, 0, MPI_COMM_WORLD, mpi_err) + + ! At the end of the simulation, store the results back in the + ! regular TallyResults array + if (current_batch == n_batches) then + t % results(:,:) % sum = tally_temp(1,:,:) + t % results(:,:) % sum_sq = tally_temp(2,:,:) + end if + + ! Write reduced tally results to file + call write_tally_result(t % results, "results", & + group="tallies/tally" // to_str(i), n1=m, n2=n) + else + ! Receive buffer not significant at other processors + call MPI_REDUCE(tally_temp, dummy, n_bins, MPI_REAL8, MPI_SUM, & + 0, MPI_COMM_WORLD, mpi_err) + end if + + ! Deallocate temporary copy of tally results + deallocate(tally_temp) + end do TALLY_RESULTS + else + if (master) then + ! Indicate that tallies are off + call write_data(0, "tallies_present", group="tallies") + end if + end if + + end subroutine write_tally_results_nr + !=============================================================================== ! LOAD_STATE_POINT !=============================================================================== From d4e770527e28c02230c3c90e1eb67b0de87ccb5a Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 21 May 2013 08:47:43 -0400 Subject: [PATCH 51/65] user has the option of opening a file for just reading or opening a file for just writing (hdf5 only has read/write for writing) --- src/hdf5_interface.F90 | 4 ++-- src/mpiio_interface.F90 | 6 +++--- src/output_interface.F90 | 4 ++-- src/state_point.F90 | 2 +- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index e9247dedf8..c1c6cdb73b 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -75,7 +75,7 @@ contains ! Determine access type open_mode = H5F_ACC_RDONLY_F - if (trim(mode) == 'rw') then + if (trim(mode) == 'w') then open_mode = H5F_ACC_RDWR_F end if @@ -139,7 +139,7 @@ contains ! Determine access type open_mode = H5F_ACC_RDONLY_F - if (trim(mode) == 'rw') then + if (trim(mode) == 'w') then open_mode = H5F_ACC_RDWR_F end if diff --git a/src/mpiio_interface.F90 b/src/mpiio_interface.F90 index 36d453b359..f86697b565 100644 --- a/src/mpiio_interface.F90 +++ b/src/mpiio_interface.F90 @@ -32,15 +32,15 @@ contains subroutine mpi_open_file(filename, fh, mode) character(*), intent(in) :: filename ! name of file to open - character(*), intent(in) :: mode ! open 'r' read, 'rw' read/write + character(*), intent(in) :: mode ! open 'r' read, 'w' write integer, intent(inout) :: fh ! file handle integer :: open_mode ! Determine access mode open_mode = MPI_MODE_RDONLY - if (mode == 'rw') then - open_mode = MPI_MODE_RDWR + if (mode == 'w') then + open_mode = MPI_MODE_WRONLY end if ! Create the file diff --git a/src/output_interface.F90 b/src/output_interface.F90 index f3db2d0e77..bd5bdcfc34 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -105,8 +105,8 @@ contains call mpi_open_file(filename, mpi_fh, mode) #else ! Check for read/write mode to open, default is read only - if (mode == 'rw') then - open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION='readwrite', & + if (mode == 'w') then + open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION='write', & STATUS='old', ACCESS='stream') else open(UNIT=UNIT_OUTPUT, FILE=filename, ACTION='read', & diff --git a/src/state_point.F90 b/src/state_point.F90 index 1278719bb2..ff0a0dfb11 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -275,7 +275,7 @@ contains else ! Close HDF5 serial file and reopen in parallel call file_close('serial') - call file_open(filename, 'parallel', 'rw') + call file_open(filename, 'parallel', 'w') # endif #endif From 92e581a26b32b6020bb92114d40ca051e289c0cd Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 21 May 2013 08:52:46 -0400 Subject: [PATCH 52/65] added compiler directives around MPI calls in no_reduce tally writing --- src/state_point.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index ff0a0dfb11..9674582f48 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -330,9 +330,10 @@ contains if (master) then ! The MPI_IN_PLACE specifier allows the master to copy values into a ! receive buffer without having a temporary variable +#ifdef MPI call MPI_REDUCE(MPI_IN_PLACE, global_temp, n_bins, MPI_REAL8, MPI_SUM, & 0, MPI_COMM_WORLD, mpi_err) - +#endif ! Transfer values to value on master if (current_batch == n_batches) then global_tallies(:) % sum = global_temp(1,:) @@ -344,8 +345,10 @@ contains n1=N_GLOBAL_TALLIES, n2=1) else ! Receive buffer not significant at other processors +#ifdef MPI call MPI_REDUCE(global_temp, dummy, n_bins, MPI_REAL8, MPI_SUM, & 0, MPI_COMM_WORLD, mpi_err) +#endif end if if (tallies_on) then @@ -372,9 +375,10 @@ contains if (master) then ! The MPI_IN_PLACE specifier allows the master to copy values into ! a receive buffer without having a temporary variable +#ifdef MPI call MPI_REDUCE(MPI_IN_PLACE, tally_temp, n_bins, MPI_REAL8, & MPI_SUM, 0, MPI_COMM_WORLD, mpi_err) - +#endif MPI ! At the end of the simulation, store the results back in the ! regular TallyResults array if (current_batch == n_batches) then @@ -387,8 +391,10 @@ contains group="tallies/tally" // to_str(i), n1=m, n2=n) else ! Receive buffer not significant at other processors +#ifdef MPI call MPI_REDUCE(tally_temp, dummy, n_bins, MPI_REAL8, MPI_SUM, & 0, MPI_COMM_WORLD, mpi_err) +#endif end if ! Deallocate temporary copy of tally results From 9d4925364c238be35bd5ddbc58d0412ce8ec651f Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 21 May 2013 08:56:47 -0400 Subject: [PATCH 53/65] fixed a compiler directive --- src/state_point.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index 9674582f48..9286552abb 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -378,7 +378,7 @@ contains #ifdef MPI call MPI_REDUCE(MPI_IN_PLACE, tally_temp, n_bins, MPI_REAL8, & MPI_SUM, 0, MPI_COMM_WORLD, mpi_err) -#endif MPI +#endif ! At the end of the simulation, store the results back in the ! regular TallyResults array if (current_batch == n_batches) then From 8bbd6a7125b1c7f6e8b782f7840cc580f2474827 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 21 May 2013 09:09:01 -0400 Subject: [PATCH 54/65] added back in comment for no reduce option --- src/state_point.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/state_point.F90 b/src/state_point.F90 index 9286552abb..2f79955703 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -204,6 +204,8 @@ contains ! Check for the no-tally-reduction method if (.not. reduce_tallies) then + ! If using the no-tally-reduction method, we need to collect tally + ! results before writing them to the state point file. call write_tally_results_nr() From 20af0893ee0c6970aa49da1b933bb9c9e257d4ae Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 21 May 2013 09:49:27 -0400 Subject: [PATCH 55/65] fixed file io for new filetype capability, must be set to parallel for all procs to read dataset --- src/initialize.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/initialize.F90 b/src/initialize.F90 index c6c8dd1399..a04c8a2200 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -332,9 +332,9 @@ contains i = i + 1 ! Check what type of file this is - call file_open(argv(i), 'serial', 'r') + call file_open(argv(i), 'parallel', 'r') call read_data(filetype, 'filetype') - call file_close('serial') + call file_close('parallel') ! Set path and flag for type of run select case (filetype) From b2f1c10f5f2d655c2e0b9100f2c6d8f5153f8df8 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 21 May 2013 09:50:15 -0400 Subject: [PATCH 56/65] switched mpi_err in mpiio interface module to mpiio_err to not conflict with global which may be used --- src/mpiio_interface.F90 | 34 +++++++++++++++++----------------- src/output_interface.F90 | 12 ++++++------ 2 files changed, 23 insertions(+), 23 deletions(-) diff --git a/src/mpiio_interface.F90 b/src/mpiio_interface.F90 index f86697b565..d3e9774df8 100644 --- a/src/mpiio_interface.F90 +++ b/src/mpiio_interface.F90 @@ -5,8 +5,8 @@ module mpiio_interface implicit none - integer :: mpi_fh ! MPI file handle - integer :: mpi_err ! MPI error code + integer :: mpi_fh ! MPI file handle + integer :: mpiio_err ! MPI error code contains @@ -21,7 +21,7 @@ contains ! Create the file call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, MPI_MODE_CREATE + & - MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpi_err) + MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpiio_err) end subroutine mpi_create_file @@ -45,7 +45,7 @@ contains ! Create the file call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, & - open_mode, MPI_INFO_NULL, fh, mpi_err) + open_mode, MPI_INFO_NULL, fh, mpiio_err) end subroutine mpi_open_file @@ -57,7 +57,7 @@ contains integer, intent(inout) :: fh ! file handle - call MPI_FILE_CLOSE(fh, mpi_err) + call MPI_FILE_CLOSE(fh, mpiio_err) end subroutine mpi_close_file @@ -71,7 +71,7 @@ contains integer, intent(in) :: buffer ! data to write call MPI_FILE_WRITE(fh, buffer, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) end subroutine mpi_write_integer @@ -86,7 +86,7 @@ contains integer, intent(in) :: buffer(:) ! data to write call MPI_FILE_WRITE(fh, buffer, length, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) end subroutine mpi_write_integer_1Darray @@ -100,7 +100,7 @@ contains integer(8), intent(in) :: buffer ! data to write call MPI_FILE_WRITE(fh, buffer, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) end subroutine mpi_write_long @@ -114,7 +114,7 @@ contains real(8), intent(in) :: buffer ! data to write call MPI_FILE_WRITE(fh, buffer, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) end subroutine mpi_write_double @@ -129,7 +129,7 @@ contains real(8), intent(in) :: buffer(:) ! data to write call MPI_FILE_WRITE(fh, buffer, length, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) end subroutine mpi_write_double_1Darray @@ -144,7 +144,7 @@ contains integer, intent(in) :: length ! length of data call MPI_FILE_WRITE(fh, buffer, length, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) end subroutine mpi_write_string @@ -158,7 +158,7 @@ contains integer, intent(inout) :: buffer ! read data to here call MPI_FILE_READ(fh, buffer, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) end subroutine mpi_read_integer @@ -173,7 +173,7 @@ contains integer, intent(inout) :: buffer(:) ! read data to here call MPI_FILE_READ(fh, buffer, length, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) end subroutine mpi_read_integer_1Darray @@ -187,7 +187,7 @@ contains integer(8), intent(inout) :: buffer ! read data to here call MPI_FILE_READ(fh, buffer, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) end subroutine mpi_read_long @@ -201,7 +201,7 @@ contains real(8), intent(inout) :: buffer ! read data to here call MPI_FILE_READ(fh, buffer, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) end subroutine mpi_read_double @@ -216,7 +216,7 @@ contains real(8), intent(inout) :: buffer(:) ! read data to here call MPI_FILE_READ(fh, buffer, length, MPI_REAL8, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) end subroutine mpi_read_double_1Darray @@ -231,7 +231,7 @@ contains integer, intent(in) :: length ! length of string call MPI_FILE_READ(fh, buffer, length, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) end subroutine mpi_read_string diff --git a/src/output_interface.F90 b/src/output_interface.F90 index bd5bdcfc34..c462bc2f10 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -748,7 +748,7 @@ contains ! Write out tally buffer call MPI_FILE_WRITE(mpi_fh, buffer, n1*n2, MPI_TALLYRESULT, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) #else @@ -805,7 +805,7 @@ contains ! Write out tally buffer call MPI_FILE_READ(mpi_fh, buffer, n1*n2, MPI_TALLYRESULT, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) #else @@ -909,7 +909,7 @@ contains #elif MPI ! Get current offset for master - if (master) call MPI_FILE_GET_POSITION(mpi_fh, offset, mpi_err) + if (master) call MPI_FILE_GET_POSITION(mpi_fh, offset, mpiio_err) ! Determine offset on master process and broadcast to all processors call MPI_SIZEOF(offset, size_offset_kind, mpi_err) @@ -926,7 +926,7 @@ contains ! Write all source sites call MPI_FILE_WRITE_AT(mpi_fh, offset, source_bank(1), work, MPI_BANK, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) #else @@ -1009,7 +1009,7 @@ contains #elif MPI ! Get current offset for master - if (master) call MPI_FILE_GET_POSITION(mpi_fh, offset, mpi_err) + if (master) call MPI_FILE_GET_POSITION(mpi_fh, offset, mpiio_err) ! Determine offset on master process and broadcast to all processors call MPI_SIZEOF(offset, size_offset_kind, mpi_err) @@ -1026,7 +1026,7 @@ contains ! Write all source sites call MPI_FILE_READ_AT(mpi_fh, offset, source_bank(1), work, MPI_BANK, & - MPI_STATUS_IGNORE, mpi_err) + MPI_STATUS_IGNORE, mpiio_err) #else From 9f0e94f91f7aed5e474c28203ea3ca91472ad8cd Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Tue, 21 May 2013 12:53:44 -0400 Subject: [PATCH 57/65] fixed writing tally result for no_reduce option --- src/state_point.F90 | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index 58d1755b54..13eebd97b6 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -311,9 +311,10 @@ contains integer :: m ! number of score bins integer :: n_bins ! total number of bins real(8), allocatable :: tally_temp(:,:,:) ! contiguous array of results - real(8) :: global_temp(2,N_GLOBAL_TALLIES) + real(8), target :: global_temp(2,N_GLOBAL_TALLIES) real(8) :: dummy ! temporary receive buffer for non-root reduces type(TallyObject), pointer :: t => null() + type(TallyResult), allocatable :: tallyresult_temp(:,:) ! ========================================================================== ! COLLECT AND WRITE GLOBAL TALLIES @@ -338,15 +339,25 @@ contains call MPI_REDUCE(MPI_IN_PLACE, global_temp, n_bins, MPI_REAL8, MPI_SUM, & 0, MPI_COMM_WORLD, mpi_err) #endif + ! Transfer values to value on master if (current_batch == n_batches) then global_tallies(:) % sum = global_temp(1,:) global_tallies(:) % sum_sq = global_temp(2,:) end if + ! Put reduced value in temporary tally result + allocate(tallyresult_temp(N_GLOBAL_TALLIES, 1)) + tallyresult_temp(:,1) % sum = global_temp(1,:) + tallyresult_temp(:,1) % sum_sq = global_temp(2,:) + + ! Write out global tallies sum and sum_sq - call write_tally_result(global_tallies, "global_tallies", & + call write_tally_result(tallyresult_temp, "global_tallies", & n1=N_GLOBAL_TALLIES, n2=1) + + ! Deallocate temporary tally result + deallocate(tallyresult_temp) else ! Receive buffer not significant at other processors #ifdef MPI @@ -389,10 +400,18 @@ contains t % results(:,:) % sum = tally_temp(1,:,:) t % results(:,:) % sum_sq = tally_temp(2,:,:) end if + + ! Put in temporary tally result + allocate(tallyresult_temp(m,n)) + tallyresult_temp(:,:) % sum = tally_temp(1,:,:) + tallyresult_temp(:,:) % sum_sq = tally_temp(2,:,:) ! Write reduced tally results to file call write_tally_result(t % results, "results", & group="tallies/tally" // to_str(i), n1=m, n2=n) + + ! Deallocate temporary tally result + deallocate(tallyresult_temp) else ! Receive buffer not significant at other processors #ifdef MPI From 2306ee4b71fcfd8778998a6d8cd334f4311440cc Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 22 May 2013 11:52:20 -0400 Subject: [PATCH 58/65] changed how strings are written out and added parallel routines --- src/hdf5_interface.F90 | 220 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 218 insertions(+), 2 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index c1c6cdb73b..f3cc59a7ce 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -385,13 +385,26 @@ contains ! HDF5_WRITE_STRING writes string data !=============================================================================== - subroutine hdf5_write_string(group, name, buffer) + 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 - call h5ltmake_dataset_string_f(group, name, buffer, hdf5_err) + 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)) + call h5dwrite_f(dset, H5T_STRING, f_ptr, hdf5_err) + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) +! call h5ltmake_dataset_string_f(group, name, buffer, hdf5_err) end subroutine hdf5_write_string @@ -530,6 +543,209 @@ contains end subroutine hdf5_read_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 + + type(c_ptr), dimension(1), target :: buf_ptr + character(len=length, kind=c_char), pointer :: 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) + + ! Read data + f_ptr = c_loc(buf_ptr(1)) + call h5dread_f(dset, H5T_STRING, f_ptr, hdf5_err, xfer_prp=plist) + + ! Set to string + call c_f_pointer(buf_ptr(1), chr_ptr) + buffer = chr_ptr + + ! Close dataset and property list + call h5dclose_f(dset, hdf5_err) + call h5pclose_f(plist, hdf5_err) + + ! Nullify pointers + nullify(chr_ptr) + + end subroutine hdf5_parallel_read_string + +# endif + #endif end module hdf5_interface From 535e07002391658446fbec0e6406a36afcfabab8 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 22 May 2013 11:57:31 -0400 Subject: [PATCH 59/65] added option for collective or independent read when in PHDF5 --- src/output_interface.F90 | 149 +++++++++++++++++++++++++++++++-------- src/state_point.F90 | 103 +++++++++++++++------------ 2 files changed, 174 insertions(+), 78 deletions(-) diff --git a/src/output_interface.F90 b/src/output_interface.F90 index c462bc2f10..5f421a6d25 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -184,11 +184,12 @@ contains ! READ_DOUBLE reads double precision scalar data !=============================================================================== - subroutine read_double(buffer, name, group) + subroutine read_double(buffer, name, group, option) 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 #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -197,10 +198,24 @@ contains else temp_group = hdf5_fh endif - - ! Read the data +# 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 +# else + ! Read the data 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 @@ -247,12 +262,13 @@ contains ! READ_DOUBLE_1DARRAY reads double precision 1-D array data !=============================================================================== - subroutine read_double_1Darray(buffer, name, group, length) + subroutine read_double_1Darray(buffer, name, group, length, option) 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 #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -261,10 +277,24 @@ contains else temp_group = hdf5_fh endif - - ! Read the data +# 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 +# else + ! Read the data serial call hdf5_read_double_1Darray(temp_group, name, buffer, length) - +# endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI @@ -372,11 +402,12 @@ contains ! READ_INTEGER reads integer scalar data !=============================================================================== - subroutine read_integer(buffer, name, group) + 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 #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -385,10 +416,24 @@ contains else temp_group = hdf5_fh endif - - ! Read the data +# 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 +# else + ! Read the data 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 @@ -436,12 +481,13 @@ contains ! READ_INTEGER_1DARRAY reads integer 1-D array data !=============================================================================== - subroutine read_integer_1Darray(buffer, name, group, length) + subroutine read_integer_1Darray(buffer, name, group, length, 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 :: option ! read option #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -450,9 +496,24 @@ contains else temp_group = hdf5_fh endif - - ! Read the data +# 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 +# else + ! Read the data serial call hdf5_read_integer_1Darray(temp_group, name, buffer, length) +# endif if (present(group)) call hdf5_close_group() #elif MPI call mpi_read_integer_1Darray(mpi_fh, buffer, length) @@ -559,11 +620,12 @@ contains ! READ_LONG reads long integer scalar data !=============================================================================== - subroutine read_long(buffer, name, group) + subroutine read_long(buffer, name, group, option) 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 #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -572,10 +634,24 @@ contains else temp_group = hdf5_fh endif - - ! Read the data +# 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 +# else + ! Read the data serial call hdf5_read_long(temp_group, name, buffer, hdf5_integer8_t) - +# endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI @@ -611,7 +687,7 @@ contains endif ! Write the data - call hdf5_write_string(temp_group, name, buffer) + call hdf5_write_string(temp_group, name, buffer, len(buffer)) ! Check if HDf5 group should be closed if (present(group)) call hdf5_close_group() @@ -631,17 +707,17 @@ contains ! READ_STRING reads string data !=============================================================================== - subroutine read_string(buffer, name, group) + subroutine read_string(buffer, name, group, option) 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 -#ifndef HDF5 -# ifdef MPI integer :: n ! length of string to read to -# endif -#endif + + ! Length of string buffer to read + n = len(buffer) #ifdef HDF5 ! Check if HDF5 group should be created/opened @@ -650,17 +726,28 @@ contains else temp_group = hdf5_fh endif - - ! Read the data +# 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 +# else + ! Read the data serial call hdf5_read_string(temp_group, name, buffer) - +# endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group() #elif MPI - ! Length of string buffer to read - n = len(buffer) - ! Read the data call mpi_read_string(mpi_fh, buffer, n) #else diff --git a/src/state_point.F90 b/src/state_point.F90 index 13eebd97b6..83ccb1f4cc 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -456,11 +456,11 @@ contains call file_open(path_state_point, 'parallel', 'r') ! Read filetype - call read_data(int_array(1), "filetype") + call read_data(int_array(1), "filetype", option="collective") ! Read revision number for state point file and make sure it matches with ! current version - call read_data(int_array(1), "revision") + call read_data(int_array(1), "revision", option="collective") if (int_array(1) /= REVISION_STATEPOINT) then message = "State point version does not match current version " & // "in OpenMC." @@ -468,9 +468,9 @@ contains end if ! Read OpenMC version - call read_data(int_array(1), "version_major") - call read_data(int_array(2), "version_minor") - call read_data(int_array(3), "version_release") + 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") 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 " & @@ -479,68 +479,70 @@ contains end if ! Read date and time - call read_data(current_time, "date_and_time") + call read_data(current_time, "date_and_time", option="collective") ! Read path to input - call read_data(path_temp, "path") + call read_data(path_temp, "path", option="collective") ! Read and overwrite random number seed - call read_data(seed, "seed") + call read_data(seed, "seed", option="collective") ! Read and overwrite run information except number of batches - call read_data(run_mode, "run_mode") - call read_data(n_particles, "n_particles") - call read_data(int_array(1), "n_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") ! 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") + call read_data(restart_batch, "current_batch", option="collective") ! Read information specific to eigenvalue run if (run_mode == MODE_EIGENVALUE) then - call read_data(int_array(1), "n_inactive") - call read_data(gen_per_batch, "gen_per_batch") + 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) - call read_data(entropy, "entropy", length=restart_batch*gen_per_batch) - call read_data(k_col_abs, "k_col_abs") - call read_data(k_col_tra, "k_col_tra") - call read_data(k_abs_tra, "k_abs_tra") - call read_data(real_array(1:2), "k_combined", length=2) + 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") ! 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") + call read_data(n_meshes, "n_meshes", group="tallies", option="collective") ! 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)) + group="tallies/mesh" // to_str(i), option="collective") call read_data(meshes(i) % type, "type", & - group="tallies/mesh" // to_str(i)) + group="tallies/mesh" // to_str(i), option="collective") call read_data(meshes(i) % n_dimension, "n_dimension", & - group="tallies/mesh" // to_str(i)) + group="tallies/mesh" // to_str(i), option="collective") call read_data(meshes(i) % dimension, "dimension", & group="tallies/mesh" // to_str(i), & - length=meshes(i) % n_dimension) + length=meshes(i) % n_dimension, option="collective") call read_data(meshes(i) % lower_left, "lower_left", & group="tallies/mesh" // to_str(i), & - length=meshes(i) % n_dimension) + length=meshes(i) % n_dimension, option="collective") call read_data(meshes(i) % upper_right, "upper_right", & group="tallies/mesh" // to_str(i), & - length=meshes(i) % n_dimension) + length=meshes(i) % n_dimension, option="collective") call read_data(meshes(i) % width, "width", & group="tallies/mesh" // to_str(i), & - length=meshes(i) % n_dimension) + length=meshes(i) % n_dimension, option="collective") end do MESH_LOOP ! Read and overwrite number of tallies - call read_data(n_tallies, "n_tallies", group="tallies") + call read_data(n_tallies, "n_tallies", group="tallies", option="collective") ! Read in tally metadata TALLY_METADATA: do i = 1, n_tallies @@ -549,17 +551,18 @@ contains t => tallies(i) ! Read tally id - call read_data(t % id, "id", group="tallies/tally" // to_str(i)) + call read_data(t % id, "id", group="tallies/tally" // to_str(i), & + option="collective") ! Read number of realizations call read_data(t % n_realizations, "n_realizations", & - group="tallies/tally" // to_str(i)) + group="tallies/tally" // to_str(i), option="collective") ! Read size of tally results call read_data(int_array(1), "total_score_bins", & - group="tallies/tally" // to_str(i)) + group="tallies/tally" // to_str(i), option="collective") call read_data(int_array(2), "total_filter_bins", & - group="tallies/tally" // to_str(i)) + group="tallies/tally" // to_str(i), option="collective") ! Check size of tally results array if (int_array(1) /= t % total_score_bins .and. & @@ -570,41 +573,44 @@ contains ! Read number of filters call read_data(t % n_filters, "n_filters", & - group="tallies/tally" // to_str(i)) + group="tallies/tally" // to_str(i), option="collective") ! 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)) + group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j), & + option="collective") ! 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)) + group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j), & + option="collective") ! 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", & group="tallies/tally" // trim(to_str(i)) // "/filter" // to_str(j), & - length=size(t % filters(j) % real_bins)) + length=size(t % filters(j) % real_bins), option="collective") else call 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)) + length=size(t % filters(j) % int_bins), option="collective") 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)) + group="tallies/tally" // to_str(i), option="collective") ! 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) + group="tallies/tally" // to_str(i), length=t % n_nuclide_bins, & + option="collective") NUCLIDE_LOOP: do j = 1, t % n_nuclide_bins if (temp_array(j) > 0) then nuclides(t % nuclide_bins(j)) % zaid = temp_array(j) @@ -616,15 +622,17 @@ contains ! 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)) + 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) + 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) + group="tallies/tally" // to_str(i), length=t % n_score_bins, & + option="collective") ! Write number of user score bins call read_data(t % n_user_score_bins, "n_user_score_bins", & - group="tallies/tally" // to_str(i)) + group="tallies/tally" // to_str(i), option="collective") end do TALLY_METADATA @@ -632,10 +640,10 @@ contains if (master) then ! Read number of realizations for global tallies - call read_data(n_realizations, "n_realizations") + call read_data(n_realizations, "n_realizations", option="independent") ! Read number of global tallies - call read_data(int_array(1), "n_global_tallies") + call read_data(int_array(1), "n_global_tallies", option="independent") if (int_array(1) /= N_GLOBAL_TALLIES) then message = "Number of global tallies does not match in state point." call fatal_error() @@ -646,7 +654,8 @@ contains n1=N_GLOBAL_TALLIES, n2=1) ! Check if tally results are present - call read_data(int_array(1), "tallies_present", group="tallies") + call read_data(int_array(1), "tallies_present", group="tallies", & + option="independent") ! Read in sum and sum squared if (int_array(1) == 1) then From 61c45ac026c134c1d4466bc6eb58b6240b816780 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 22 May 2013 14:24:41 -0400 Subject: [PATCH 60/65] changed write and read parallel string to F90 from F2003 due to IBM compiler --- src/hdf5_interface.F90 | 67 ++++++++++++++++++++++++++++++------------ 1 file changed, 49 insertions(+), 18 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index f3cc59a7ce..d78fab080e 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -392,19 +392,41 @@ contains character(*), intent(in) :: buffer ! data to write integer, intent(in) :: length - type(c_ptr), dimension(1), target :: wdata - character(len=length, kind=c_char), dimension(1), target :: c_str + 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) - c_str(1) = buffer - wdata(1) = c_loc(c_str(1)) - f_ptr = c_loc(wdata(1)) - call h5dwrite_f(dset, H5T_STRING, f_ptr, 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) -! call h5ltmake_dataset_string_f(group, name, buffer, hdf5_err) end subroutine hdf5_write_string @@ -715,8 +737,15 @@ contains integer, intent(in) :: p_type ! independent or collective IO integer, intent(in) :: length ! length of string - type(c_ptr), dimension(1), target :: buf_ptr - character(len=length, kind=c_char), pointer :: chr_ptr + 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) @@ -727,21 +756,23 @@ contains ! Open dataset call h5dopen_f(group, name, dset, hdf5_err) - ! Read data - f_ptr = c_loc(buf_ptr(1)) - call h5dread_f(dset, H5T_STRING, f_ptr, hdf5_err, xfer_prp=plist) + ! Get dataspace to read + call h5dget_space_f(dset, dspace, hdf5_err) - ! Set to string - call c_f_pointer(buf_ptr(1), chr_ptr) - buffer = chr_ptr + ! 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) + + ! Copy over buffer + buffer = str_tmp(1) ! Close dataset and property list call h5dclose_f(dset, hdf5_err) call h5pclose_f(plist, hdf5_err) - ! Nullify pointers - nullify(chr_ptr) - end subroutine hdf5_parallel_read_string # endif From b68843a66d08d0718a5a1d8e51d2566e870f0e21 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 22 May 2013 16:30:30 -0400 Subject: [PATCH 61/65] put collective property for string reading --- src/hdf5_interface.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index d78fab080e..471a4397cb 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -422,7 +422,8 @@ contains 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) + 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) @@ -764,7 +765,8 @@ contains dims1(1) = length ! Read in the data - call h5dread_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, mem_space_id=dspace) + 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) From a434c24979910dbb8992f3aa7a5ede413e8fe40d Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Wed, 22 May 2013 16:41:45 -0400 Subject: [PATCH 62/65] removed independent I/O from only master reads during tally result read --- src/state_point.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index 83ccb1f4cc..2107b9404b 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -640,10 +640,10 @@ contains if (master) then ! Read number of realizations for global tallies - call read_data(n_realizations, "n_realizations", option="independent") + call read_data(n_realizations, "n_realizations") ! Read number of global tallies - call read_data(int_array(1), "n_global_tallies", option="independent") + call 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() @@ -654,8 +654,8 @@ contains n1=N_GLOBAL_TALLIES, n2=1) ! Check if tally results are present - call read_data(int_array(1), "tallies_present", group="tallies", & - option="independent") + call read_data(int_array(1), "tallies_present", group="tallies") +! option="independent") ! Read in sum and sum squared if (int_array(1) == 1) then From f3a229c0596c11688e71362f7f1f7cad51293550 Mon Sep 17 00:00:00 2001 From: Bryan Herman Date: Thu, 23 May 2013 08:26:56 -0400 Subject: [PATCH 63/65] removed commented line --- src/state_point.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index 2107b9404b..4628221581 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -655,7 +655,6 @@ contains ! Check if tally results are present call read_data(int_array(1), "tallies_present", group="tallies") -! option="independent") ! Read in sum and sum squared if (int_array(1) == 1) then From 9beb04af05e717a4bba60db2234a3b855e1bd1df Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 23 May 2013 17:45:26 -0400 Subject: [PATCH 64/65] Fixed bug in k_generation calculation. --- src/eigenvalue.F90 | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/src/eigenvalue.F90 b/src/eigenvalue.F90 index f8e56fcaf9..fc44489d00 100644 --- a/src/eigenvalue.F90 +++ b/src/eigenvalue.F90 @@ -572,16 +572,15 @@ contains #ifdef MPI ! Combine values across all processors - call MPI_REDUCE(keff_generation, k_generation(overall_gen), 1, MPI_REAL8, & - MPI_SUM, 0, MPI_COMM_WORLD, mpi_err) + call MPI_ALLREDUCE(keff_generation, k_generation(overall_gen), 1, & + MPI_REAL8, MPI_SUM, MPI_COMM_WORLD, mpi_err) #else k_generation(overall_gen) = keff_generation #endif ! Normalize single batch estimate of k ! TODO: This should be normalized by total_weight, not by n_particles - if (master) k_generation(overall_gen) = & - k_generation(overall_gen) / n_particles + k_generation(overall_gen) = k_generation(overall_gen) / n_particles end subroutine calculate_generation_keff @@ -627,11 +626,6 @@ contains end if end if -#ifdef MPI - ! Broadcast new keff value to all processors - call MPI_BCAST(keff, 1, MPI_REAL8, 0, MPI_COMM_WORLD, mpi_err) -#endif - end subroutine calculate_average_keff !=============================================================================== From e35059b968b935d4eda47779bc687291ca426340 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 9 Jun 2013 17:30:57 -0400 Subject: [PATCH 65/65] Added filetype to statepoint.py and fixed revision and k_generation. --- src/utils/statepoint.py | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/utils/statepoint.py b/src/utils/statepoint.py index bf3076cf62..09836efb89 100644 --- a/src/utils/statepoint.py +++ b/src/utils/statepoint.py @@ -147,8 +147,11 @@ class StatePoint(object): self._read_metadata() def _read_metadata(self): + # Read filetype + self.filetype = self._get_int(path='filetype')[0] + # Read statepoint revision - self.revision = self._get_int(path='revision_statepoint')[0] + self.revision = self._get_int(path='revision')[0] # Read OpenMC version if self._hdf5: @@ -179,7 +182,8 @@ class StatePoint(object): if self.run_mode == 2: self.n_inactive = self._get_int(path='n_inactive')[0] self.gen_per_batch = self._get_int(path='gen_per_batch')[0] - self.k_batch = self._get_double(self.current_batch, path='k_batch') + self.k_batch = self._get_double( + self.current_batch*self.gen_per_batch, path='k_generation') self.entropy = self._get_double( self.current_batch*self.gen_per_batch, path='entropy') if self.revision >= 8: