From c00834dbb6cbaa2e287f6f5645d69f317ef3ba30 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 29 Aug 2015 16:31:29 +0700 Subject: [PATCH 01/32] Make sure Fortran module directory is included. Get rid of verbose option. --- CMakeLists.txt | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index fd122a14c..c4a8e8ece 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,6 +7,9 @@ set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib) set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin) set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include) +# Make sure Fortran module directory is included when building +include_directories(${CMAKE_BINARY_DIR}/include) + #=============================================================================== # Architecture specific definitions #=============================================================================== @@ -23,13 +26,9 @@ option(openmp "Enable shared-memory parallelism with OpenMP" OFF) option(profile "Compile with profiling flags" OFF) option(debug "Compile with debug flags" OFF) option(optimize "Turn on all compiler optimization flags" OFF) -option(verbose "Create verbose Makefiles" OFF) option(coverage "Compile with coverage analysis flags" OFF) option(mpif08 "Use Fortran 2008 MPI interface" OFF) -if (verbose) - set(CMAKE_VERBOSE_MAKEFILE on) -endif() # Maximum number of nested coordinates levels set(maxcoord 10 CACHE STRING "Maximum number of nested coordinate levels") From ab59b90cfee9a62c61ac06696fa43485b2edc2d9 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 29 Aug 2015 16:32:02 +0700 Subject: [PATCH 02/32] Use lists for f90flags and ldflags instead of space-separated strings --- CMakeLists.txt | 115 ++++++++++++++++++++++++++++++------------------- 1 file changed, 71 insertions(+), 44 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index c4a8e8ece..e4452d323 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -65,7 +65,21 @@ endif() # Set compile/link flags based on which compiler is being used #=============================================================================== -if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") +# Support for Fortran in FindOpenMP was added in CMake 3.1. To support lower +# versions, we manually add the flags. However, at some point in time, the +# manual logic can be removed in favor of the block below + +#if(NOT (CMAKE_VERSION VERSION_LESS 3.1)) +# if(openmp) +# find_package(OpenMP) +# if(OPENMP_FOUND) +# list(APPEND f90flags ${OpenMP_Fortran_FLAGS}) +# list(APPEND ldflags ${OpenMP_Fortran_FLAGS}) +# endif() +# endif() +#endif() + +if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) # Make sure version is sufficient execute_process(COMMAND ${CMAKE_Fortran_COMPILER} -dumpversion OUTPUT_VARIABLE GCC_VERSION) @@ -74,88 +88,90 @@ if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") endif() # GNU Fortran compiler options - set(f90flags "-cpp -std=f2008 -fbacktrace") + list(APPEND f90flags -cpp -std=f2008 -fbacktrace) if(debug) - set(f90flags "-g -Wall -pedantic -fbounds-check -ffpe-trap=invalid,overflow,underflow ${f90flags}") - set(ldflags "-g") + list(APPEND f90flags -g -Wall -pedantic -fbounds-check + -ffpe-trap=invalid,overflow,underflow) + list(APPEND ldflags -g) endif() if(profile) - set(f90flags "-pg ${f90flags}") - set(ldflags "-pg ${ldflags}") + list(APPEND f90flags -pg) + list(APPEND ldflags -pg) endif() if(optimize) - set(f90flags "-O3 ${f90flags}") + list(APPEND f90flags -O3) endif() if(openmp) - set(f90flags "-fopenmp ${f90flags}") - set(ldflags "-fopenmp ${ldflags}") + list(APPEND f90flags -fopenmp) + list(APPEND ldflags -fopenmp) endif() if(coverage) - set(f90flags "-coverage ${f90flags}") - set(ldflags "-coverage ${ldflags}") + list(APPEND f90flags -coverage) + list(APPEND ldflags -coverage) endif() -elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL Intel) # Intel Fortran compiler options - set(f90flags "-fpp -std08 -assume byterecl -traceback") + list(APPEND f90flags -fpp -std08 -assume byterecl -traceback) if(debug) - set(f90flags "-g -warn -ftrapuv -fp-stack-check -check all -fpe0 ${f90flags}") - set(ldflags "-g") + list(APPEND f90flags -g -warn -ftrapuv -fp-stack-check + "-check all" -fpe0) + list(APPEND ldflags -g) endif() if(profile) - set(f90flags "-pg ${f90flags}") - set(ldflags "-pg ${ldflags}") + list(APPEND f90flags -pg) + list(APPEND ldflags -pg) endif() if(optimize) - set(f90flags "-O3 ${f90flags}") + list(APPEND f90flags -O3) endif() if(openmp) - set(f90flags "-openmp ${f90flags}") - set(ldflags "-openmp ${ldflags}") + list(APPEND f90flags -openmp) + list(APPEND ldflags -openmp) endif() -elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "PGI") +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL PGI) # PGI Fortran compiler options - set(f90flags "-Mpreprocess -Minform=inform -traceback") + list(APPEND f90flags -Mpreprocess -Minform=inform -traceback) add_definitions(-DNO_F2008) if(debug) - set(f90flags "-g -Mbounds -Mchkptr -Mchkstk ${f90flags}") - set(ldflags "-g") + list(APPEND f90flags -g -Mbounds -Mchkptr -Mchkstk) + list(APPEND ldflags -g) endif() if(profile) - set(f90flags "-pg ${f90flags}") - set(ldflags "-pg ${ldflags}") + list(APPEND f90flags -pg) + list(APPEND ldflags -pg) endif() if(optimize) - set(f90flags "-fast -Mipa ${f90flags}") + list(APPEND f90flags -fast -Mipa) endif() -elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "XL") +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL XL) # IBM XL compiler options - set(f90flags "-O2") + list(APPEND f90flags -O2) add_definitions(-DNO_F2008) if(debug) - set(f90flags "-g -C -qflag=i:i -u") - set(ldflags "-g") + list(APPEND f90flags -g -C -qflag=i:i -u) + list(APPEND ldflags -g) endif() if(profile) - set(f90flags "-p ${f90flags}") - set(ldflags "-p ${ldflags}") + list(APPEND f90flags -p) + list(APPEND ldflags -p) endif() if(optimize) - set(f90flags "-O3 ${f90flags}") + list(APPEND f90flags -O3) endif() if(openmp) - set(f90flags "-qsmp=omp ${f90flags}") - set(ldflags "-qsmp=omp ${ldflags}") + list(APPEND f90flags -qsmp=omp) + list(APPEND ldflags -qsmp=omp) endif() -elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Cray") +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL Cray) # Cray Fortran compiler options - set(f90flags "-e Z -m 0") + list(APPEND f90flags -e Z -m 0) if(debug) - set(f90flags "-g -R abcnsp -O0 ${f90flags}") - set(ldflags "-g") + list(APPEND f90flags -g -R abcnsp -O0) + list(APPEND ldflags -g) endif() endif() @@ -203,10 +219,21 @@ add_subdirectory(src/xml/fox) set(program "openmc") file(GLOB source src/*.F90 src/xml/openmc_fox.F90) add_executable(${program} ${source}) -target_link_libraries(${program} ${libraries} fox_dom) -set_target_properties(${program} PROPERTIES - COMPILE_FLAGS "${f90flags}" - LINK_FLAGS "${ldflags}") + +# target_compile_options was added in CMake 2.8.12 and is the recommended way to +# set compile flags. Note that this sets the COMPILE_OPTIONS property (also +# available only in 2.8.12+) rather than the COMPILE_FLAGS property, which is +# deprecated. The former can handle lists whereas the latter cannot. +if(CMAKE_VERSION VERSION_LESS 4.8.12) + string(REPLACE ";" " " f90flags "${f90flags}") + set_property(TARGET ${program} PROPERTY COMPILE_FLAGS "${f90flags}") +else() + target_compile_options(${program} PUBLIC ${f90flags}) +endif() + +# target_link_libraries treats any arguments starting with - but not -l as +# linker flags. Thus, we can pass both linker flags and libraries together. +target_link_libraries(${program} ${ldflags} ${libraries} fox_dom) #=============================================================================== # Install executable, scripts, manpage, license From e93afed7a08be46e4b95f58f0384d6590750a2a7 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 16 Jul 2015 18:56:35 +0400 Subject: [PATCH 03/32] Make HDF5 only binary output option in source and Python API. Still need to update test suite and get rid of output_interface. --- openmc/particle_restart.py | 38 +-- openmc/statepoint.py | 80 +---- src/finalize.F90 | 4 - src/global.F90 | 4 - src/hdf5_interface.F90 | 4 - src/hdf5_summary.F90 | 4 - src/initialize.F90 | 17 +- src/output.F90 | 92 ----- src/output_interface.F90 | 599 +++++---------------------------- src/particle_restart_write.F90 | 4 - src/source.F90 | 4 - src/state_point.F90 | 23 +- src/track_output.F90 | 6 - 13 files changed, 109 insertions(+), 770 deletions(-) diff --git a/openmc/particle_restart.py b/openmc/particle_restart.py index d664de1ae..5ae534dbd 100644 --- a/openmc/particle_restart.py +++ b/openmc/particle_restart.py @@ -40,13 +40,8 @@ class Particle(object): """ def __init__(self, filename): - if filename.endswith('.h5'): - import h5py - self._f = h5py.File(filename, 'r') - self._hdf5 = True - else: - self._f = open(filename, 'rb') - self._hdf5 = False + import h5py + self._f = h5py.File(filename, 'r') # Read all metadata self._read_data() @@ -74,36 +69,17 @@ class Particle(object): self.xyz = self._get_double(3, path='xyz') self.uvw = self._get_double(3, path='uvw') - def _get_data(self, n, typeCode, size): - return list(struct.unpack('={0}{1}'.format(n, typeCode), - self._f.read(n*size))) - def _get_int(self, n=1, path=None): - if self._hdf5: - return [int(v) for v in self._f[path].value] - else: - return [int(v) for v in self._get_data(n, 'i', 4)] + return [int(v) for v in self._f[path].value] def _get_long(self, n=1, path=None): - if self._hdf5: - return [int(v) for v in self._f[path].value] - else: - return [int(v) for v in self._get_data(n, 'q', 8)] + return [int(v) for v in self._f[path].value] def _get_float(self, n=1, path=None): - if self._hdf5: - return [float(v) for v in self._f[path].value] - else: - return [float(v) for v in self._get_data(n, 'f', 4)] + return [float(v) for v in self._f[path].value] def _get_double(self, n=1, path=None): - if self._hdf5: - return [float(v) for v in self._f[path].value] - else: - return [float(v) for v in self._get_data(n, 'd', 8)] + return [float(v) for v in self._f[path].value] def _get_string(self, n=1, path=None): - if self._hdf5: - return str(self._f[path].value) - else: - return str(self._get_data(n, 's', 1)[0]) + return str(self._f[path].value) diff --git a/openmc/statepoint.py b/openmc/statepoint.py index 6a4713e91..673b41e17 100644 --- a/openmc/statepoint.py +++ b/openmc/statepoint.py @@ -92,13 +92,8 @@ class StatePoint(object): """ def __init__(self, filename): - if filename.endswith('.h5'): - import h5py - self._f = h5py.File(filename, 'r') - self._hdf5 = True - else: - self._f = open(filename, 'rb') - self._hdf5 = False + import h5py + self._f = h5py.File(filename, 'r') # Set flags for what data has been read self._results = False @@ -171,12 +166,9 @@ class StatePoint(object): raise Exception('Statepoint Revision is not consistent.') # Read OpenMC version - if self._hdf5: - self._version = [self._get_int(path='version_major')[0], - self._get_int(path='version_minor')[0], - self._get_int(path='version_release')[0]] - else: - self._version = self._get_int(3) + self._version = [self._get_int(path='version_major')[0], + self._get_int(path='version_minor')[0], + self._get_int(path='version_release')[0]] # Read date and time self._date_and_time = self._get_string(19, path='date_and_time') @@ -473,13 +465,8 @@ class StatePoint(object): # Read global Tallies n_global_tallies = self._get_int(path='n_global_tallies')[0] - if self._hdf5: - data = self._f['global_tallies'].value - self._global_tallies = np.column_stack((data['sum'], data['sum_sq'])) - - else: - self._global_tallies = np.array(self._get_double(2*n_global_tallies)) - self._global_tallies.shape = (n_global_tallies, 2) + data = self._f['global_tallies'].value + self._global_tallies = np.column_stack((data['sum'], data['sum_sq'])) # Flag indicating if Tallies are present self._tallies_present = self._get_int(path='tallies/tallies_present')[0] @@ -499,15 +486,9 @@ class StatePoint(object): num_tot_bins = tally.num_bins # Extract Tally data from the file - if self._hdf5: - data = self._f['{0}{1}/results'.format(base, tally_key)].value - sum = data['sum'] - sum_sq = data['sum_sq'] - - else: - results = np.array(self._get_double(2*num_tot_bins)) - sum = results[0::2] - sum_sq = results[1::2] + data = self._f['{0}{1}/results'.format(base, tally_key)].value + sum = data['sum'] + sum_sq = data['sum_sq'] # Define a routine to convert 0 to 1 def nonzero(val): @@ -547,8 +528,7 @@ class StatePoint(object): self._source = np.empty(self._n_particles, dtype=SourceSite) # For HDF5 state points, copy entire bank - if self._hdf5: - source_sites = self._f['source_bank'].value + source_sites = self._f['source_bank'].value # Initialize SourceSite object for each particle for i in range(self._n_particles): @@ -556,13 +536,7 @@ class StatePoint(object): site = SourceSite() # Read position, angle, and energy - if self._hdf5: - site._weight, site._xyz, site._uvw, site._E = source_sites[i] - else: - site._weight = self._get_double()[0] - site._xyz = self._get_double(3) - site._uvw = self._get_double(3) - site._E = self._get_double()[0] + site._weight, site._xyz, site._uvw, site._E = source_sites[i] # Store the source site in the NumPy array self._source[i] = site @@ -798,37 +772,19 @@ class StatePoint(object): self._f.read(n*size))) def _get_int(self, n=1, path=None): - if self._hdf5: - return [int(v) for v in self._f[path].value] - else: - return [int(v) for v in self._get_data(n, 'i', 4)] + return [int(v) for v in self._f[path].value] def _get_long(self, n=1, path=None): - if self._hdf5: - return [long(v) for v in self._f[path].value] - else: - return [long(v) for v in self._get_data(n, 'q', 8)] + return [long(v) for v in self._f[path].value] def _get_float(self, n=1, path=None): - if self._hdf5: - return [float(v) for v in self._f[path].value] - else: - return [float(v) for v in self._get_data(n, 'f', 4)] + return [float(v) for v in self._f[path].value] def _get_double(self, n=1, path=None): - if self._hdf5: - return [float(v) for v in self._f[path].value] - else: - return [float(v) for v in self._get_data(n, 'd', 8)] + return [float(v) for v in self._f[path].value] def _get_double_array(self, n=1, path=None): - if self._hdf5: - return self._f[path].value - else: - return self._get_data(n, 'd', 8) + return self._f[path].value def _get_string(self, n=1, path=None): - if self._hdf5: - return str(self._f[path].value) - else: - return str(self._get_data(n, 's', 1)[0]) + return str(self._f[path].value) diff --git a/src/finalize.F90 b/src/finalize.F90 index aa11f4769..b795cdb4f 100644 --- a/src/finalize.F90 +++ b/src/finalize.F90 @@ -9,9 +9,7 @@ module finalize use message_passing #endif -#ifdef HDF5 use hdf5_interface, only: h5tclose_f, h5close_f, hdf5_err -#endif implicit none @@ -51,14 +49,12 @@ contains ! Deallocate arrays call free_memory() -#ifdef HDF5 ! 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 ! Free all MPI types diff --git a/src/global.F90 b/src/global.F90 index 564fcda84..ae2f5bb27 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -16,9 +16,7 @@ module global use trigger_header, only: KTrigger use timer_header, only: Timer -#ifdef HDF5 use hdf5_interface, only: HID_T -#endif #ifdef MPIF08 use mpi_f08 #endif @@ -270,12 +268,10 @@ module global ! ============================================================================ ! HDF5 VARIABLES -#ifdef HDF5 integer(HID_T) :: hdf5_output_file ! identifier for output file 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) -#endif ! ============================================================================ ! MISCELLANEOUS VARIABLES diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 34b72196e..e7ba39b64 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -1,7 +1,5 @@ module hdf5_interface -#ifdef HDF5 - use hdf5 use h5lt use, intrinsic :: ISO_C_BINDING @@ -1811,6 +1809,4 @@ contains # endif -#endif - end module hdf5_interface diff --git a/src/hdf5_summary.F90 b/src/hdf5_summary.F90 index 375ab7460..a9dab46f5 100644 --- a/src/hdf5_summary.F90 +++ b/src/hdf5_summary.F90 @@ -1,7 +1,5 @@ module hdf5_summary -#ifdef HDF5 - use ace_header, only: Reaction, UrrData, Nuclide use constants use endf, only: reaction_name @@ -875,6 +873,4 @@ contains end subroutine hdf5_write_timing -#endif - end module hdf5_summary diff --git a/src/initialize.F90 b/src/initialize.F90 index b944b6677..22521b24d 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -15,9 +15,8 @@ module initialize use input_xml, only: read_input_xml, read_cross_sections_xml, & cells_in_univ_dict, read_plots_xml use material_header, only: Material - use output, only: title, header, write_summary, print_version, & - print_usage, write_xs_summary, print_plot, & - write_message + use output, only: title, header, print_version, write_message, & + print_usage, write_xs_summary, print_plot use output_interface use random_lcg, only: initialize_prng use state_point, only: load_state_point @@ -33,10 +32,8 @@ module initialize use omp_lib #endif -#ifdef HDF5 use hdf5_interface use hdf5_summary, only: hdf5_write_summary -#endif implicit none @@ -60,10 +57,8 @@ contains call initialize_mpi() #endif -#ifdef HDF5 ! Initialize HDF5 interface call hdf5_initialize() -#endif ! Read command line arguments call read_command_line() @@ -155,11 +150,7 @@ contains call print_plot() else ! Write summary information -#ifdef HDF5 if (output_summary) call hdf5_write_summary() -#else - if (output_summary) call write_summary() -#endif ! Write cross section information if (output_xs) call write_xs_summary() @@ -275,8 +266,6 @@ contains end subroutine initialize_mpi #endif -#ifdef HDF5 - !=============================================================================== ! HDF5_INITIALIZE !=============================================================================== @@ -319,8 +308,6 @@ contains end subroutine hdf5_initialize -#endif - !=============================================================================== ! READ_COMMAND_LINE reads all parameters from the command line !=============================================================================== diff --git a/src/output.F90 b/src/output.F90 index d1d4ec72a..2ddbf6499 100644 --- a/src/output.F90 +++ b/src/output.F90 @@ -1203,98 +1203,6 @@ contains end subroutine print_sab_table -!=============================================================================== -! WRITE_SUMMARY displays summary information about the problem about to be run -! after reading all input files -!=============================================================================== - - subroutine write_summary() - - integer :: i ! loop index - character(MAX_FILE_LEN) :: path ! path of summary file - type(Material), pointer :: m => null() - type(TallyObject), pointer :: t => null() - - ! Create filename for log file - path = trim(path_output) // "summary.out" - - ! Open log file for writing - open(UNIT=UNIT_SUMMARY, FILE=path, STATUS='replace', ACTION='write') - - call header("OpenMC Monte Carlo Code", unit=UNIT_SUMMARY, level=1) - write(UNIT=UNIT_SUMMARY, FMT=*) & - "Copyright: 2011-2015 Massachusetts Institute of Technology" - write(UNIT=UNIT_SUMMARY, FMT='(1X,A,7X,2(I1,"."),I1)') & - "Version:", VERSION_MAJOR, VERSION_MINOR, VERSION_RELEASE -#ifdef GIT_SHA1 - write(UNIT=UNIT_SUMMARY, FMT='(1X,"Git SHA1:",6X,A)') GIT_SHA1 -#endif - write(UNIT=UNIT_SUMMARY, FMT='(1X,"Date/Time:",5X,A)') & - time_stamp() - - ! Write information on number of processors -#ifdef MPI - write(UNIT=UNIT_SUMMARY, FMT='(1X,"MPI Processes:",1X,A)') & - trim(to_str(n_procs)) -#endif - - ! Display problem summary - call header("PROBLEM SUMMARY", unit=UNIT_SUMMARY) - select case(run_mode) - case (MODE_EIGENVALUE) - write(UNIT_SUMMARY,100) 'Problem type:', 'k eigenvalue' - write(UNIT_SUMMARY,101) 'Number of Batches:', n_batches - write(UNIT_SUMMARY,101) 'Number of Inactive Batches:', n_inactive - write(UNIT_SUMMARY,101) 'Generations per Batch:', gen_per_batch - case (MODE_FIXEDSOURCE) - write(UNIT_SUMMARY,100) 'Problem type:', 'fixed source' - end select - write(UNIT_SUMMARY,101) 'Number of Particles:', n_particles - - ! Display geometry summary - call header("GEOMETRY SUMMARY", unit=UNIT_SUMMARY) - write(UNIT_SUMMARY,101) 'Number of Cells:', n_cells - write(UNIT_SUMMARY,101) 'Number of Surfaces:', n_surfaces - write(UNIT_SUMMARY,101) 'Number of Materials:', n_materials - - ! print summary of all geometry - call print_geometry() - - ! print summary of materials - call header("MATERIAL SUMMARY", unit=UNIT_SUMMARY) - do i = 1, n_materials - m => materials(i) - call print_material(m, unit=UNIT_SUMMARY) - end do - - ! print summary of tallies - if (n_tallies > 0) then - call header("TALLY SUMMARY", unit=UNIT_SUMMARY) - do i = 1, n_tallies - t=> tallies(i) - call print_tally(t, unit=UNIT_SUMMARY) - end do - end if - - ! print summary of variance reduction - call header("VARIANCE REDUCTION", unit=UNIT_SUMMARY) - if (survival_biasing) then - write(UNIT_SUMMARY,100) "Survival Biasing:", "on" - else - write(UNIT_SUMMARY,100) "Survival Biasing:", "off" - end if - write(UNIT_SUMMARY,100) "Weight Cutoff:", trim(to_str(weight_cutoff)) - write(UNIT_SUMMARY,100) "Survival weight:", trim(to_str(weight_survive)) - - ! Close summary file - close(UNIT_SUMMARY) - - ! Format descriptor for columns -100 format (1X,A,T35,A) -101 format (1X,A,T35,I11) - - end subroutine write_summary - !=============================================================================== ! WRITE_XS_SUMMARY writes information about each nuclide and S(a,b) table to a ! file called cross_sections.out. This file shows the list of reactions as well diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 05fcd0010..f56a4b339 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -5,12 +5,9 @@ module output_interface use global use tally_header, only: TallyResult -#ifdef HDF5 use hdf5_interface -#else #ifdef MPI use mpiio_interface -#endif #endif implicit none @@ -19,17 +16,8 @@ module output_interface type, public :: BinaryOutput private ! Compilation specific data -#ifdef HDF5 integer(HID_T) :: hdf5_fh integer(HID_T) :: hdf5_grp -#else - integer :: unit_fh -#ifdef MPIF08 - type(MPI_File) :: mpi_fh -#else - integer :: mpi_fh -#endif -#endif logical :: serial ! Serial I/O when using MPI/PHDF5 contains generic, public :: write_data => write_double, & @@ -87,11 +75,9 @@ module output_interface procedure, public :: read_tally_result => read_tally_result procedure, public :: write_source_bank => write_source_bank procedure, public :: read_source_bank => read_source_bank -#ifdef HDF5 procedure, public :: write_attribute_string => write_attribute_string procedure, public :: open_group => open_group procedure, public :: close_group => close_group -#endif end type BinaryOutput contains @@ -113,26 +99,14 @@ contains self % serial = .true. end if -#ifdef HDF5 -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_file_create(filename, self % hdf5_fh) else call hdf5_file_create_parallel(filename, self % hdf5_fh) endif -# else - call hdf5_file_create(filename, self % hdf5_fh) -# endif -#elif MPI - if (self % serial) then - open(NEWUNIT=self % unit_fh, FILE=filename, ACTION="write", & - STATUS='replace', ACCESS='stream') - else - call mpi_create_file(filename, self % mpi_fh) - end if #else - open(NEWUNIT=self % unit_fh, FILE=filename, ACTION="write", & - STATUS='replace', ACCESS='stream') + call hdf5_file_create(filename, self % hdf5_fh) #endif end subroutine file_create @@ -155,38 +129,14 @@ contains self % serial = .true. end if -#ifdef HDF5 -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_file_open(filename, self % hdf5_fh, mode) else call hdf5_file_open_parallel(filename, self % hdf5_fh, mode) endif -# else - call hdf5_file_open(filename, self % hdf5_fh, mode) -# endif -#elif MPI - if (self % serial) then - ! Check for read/write mode to open, default is read only - if (mode == 'w') then - open(NEWUNIT=self % unit_fh, FILE=filename, ACTION='write', & - STATUS='old', ACCESS='stream', POSITION='append') - else - open(NEWUNIT=self % unit_fh, FILE=filename, ACTION='read', & - STATUS='old', ACCESS='stream') - end if - else - call mpi_open_file(filename, self % mpi_fh, mode) - end if #else - ! Check for read/write mode to open, default is read only - if (mode == 'w') then - open(NEWUNIT=self % unit_fh, FILE=filename, ACTION='write', & - STATUS='old', ACCESS='stream', POSITION='append') - else - open(NEWUNIT=self % unit_fh, FILE=filename, ACTION='read', & - STATUS='old', ACCESS='stream') - end if + call hdf5_file_open(filename, self % hdf5_fh, mode) #endif end subroutine file_open @@ -199,21 +149,7 @@ contains class(BinaryOutput) :: self -#ifdef HDF5 -# ifdef MPI call hdf5_file_close(self % hdf5_fh) -# else - call hdf5_file_close(self % hdf5_fh) -# endif -#elif MPI - if (self % serial) then - close(UNIT=self % unit_fh) - else - call mpi_close_file(self % mpi_fh) - end if -#else - close(UNIT=self % unit_fh) -#endif end subroutine file_close @@ -221,7 +157,6 @@ contains ! OPEN_GROUP call hdf5 routine to open a group within binary output context !=============================================================================== -#ifdef HDF5 subroutine open_group(self, group) character(*), intent(in) :: group ! HDF5 group name @@ -230,13 +165,11 @@ contains call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) end subroutine open_group -#endif !=============================================================================== ! CLOSE_GROUP call hdf5 routine to close a group within binary output context !=============================================================================== -#ifdef HDF5 subroutine close_group(self) class(BinaryOutput) :: self @@ -244,7 +177,6 @@ contains call hdf5_close_group(self % hdf5_grp) end subroutine close_group -#endif !=============================================================================== ! WRITE_DOUBLE writes double precision scalar data @@ -277,33 +209,23 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_write_double(self % hdf5_grp, name_, buffer) else call hdf5_write_double_parallel(self % hdf5_grp, name_, buffer, collect_) end if -# else +#else call hdf5_write_double(self % hdf5_grp, name_, buffer) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - write(self % unit_fh) buffer - else - call mpi_write_double(self % mpi_fh, buffer, collect_) - end if -#else - write(self % unit_fh) buffer -#endif end subroutine write_double @@ -338,33 +260,23 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_read_double(self % hdf5_grp, name_, buffer) else call hdf5_read_double_parallel(self % hdf5_grp, name_, buffer, collect_) end if -# else +#else call hdf5_read_double(self % hdf5_grp, name_, buffer) -# endif +#endif ! Check if HDf5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - read(self % unit_fh) buffer - else - call mpi_read_double(self % mpi_fh, buffer, collect_) - end if -#else - read(self % unit_fh) buffer -#endif end subroutine read_double @@ -400,34 +312,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_write_double_1Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_write_double_1Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else call hdf5_write_double_1Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - write(self % unit_fh) buffer(1:length) - else - call mpi_write_double_1Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - write(self % unit_fh) buffer(1:length) -#endif end subroutine write_double_1Darray @@ -463,34 +365,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_read_double_1Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_read_double_1Darray_parallel(self % hdf5_grp, name_, buffer, & length, collect_) end if -# else +#else call hdf5_read_double_1Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - read(self % unit_fh) buffer(1:length) - else - call mpi_read_double_1Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - read(self % unit_fh) buffer(1:length) -#endif end subroutine read_double_1Darray @@ -526,34 +418,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_write_double_2Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_write_double_2Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else call hdf5_write_double_2Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - write(self % unit_fh) buffer(1:length(1),1:length(2)) - else - call mpi_write_double_2Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - write(self % unit_fh) buffer(1:length(1),1:length(2)) -#endif end subroutine write_double_2Darray @@ -589,34 +471,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_read_double_2Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_read_double_2Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else call hdf5_read_double_2Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - read(self % unit_fh) buffer(1:length(1),1:length(2)) - else - call mpi_read_double_2Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - read(self % unit_fh) buffer(1:length(1),1:length(2)) -#endif end subroutine read_double_2Darray @@ -652,34 +524,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_write_double_3Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_write_double_3Darray_parallel(self % hdf5_grp, name_, buffer, & length, collect_) end if -# else +#else call hdf5_write_double_3Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) - else - call mpi_write_double_3Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) -#endif end subroutine write_double_3Darray @@ -715,34 +577,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_read_double_3Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_read_double_3Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else call hdf5_read_double_3Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) - else - call mpi_read_double_3Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) -#endif end subroutine read_double_3Darray @@ -779,37 +631,25 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_write_double_4Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_write_double_4Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else ! Write the data in serial call hdf5_write_double_4Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & - 1:length(4)) - else - call mpi_write_double_4Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & - 1:length(4)) -#endif end subroutine write_double_4Darray @@ -846,36 +686,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_read_double_4Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_read_double_4Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else call hdf5_read_double_4Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & - 1:length(4)) - else - call mpi_read_double_4Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & - 1:length(4)) -#endif end subroutine read_double_4Darray @@ -910,33 +738,23 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_write_integer(self % hdf5_grp, name_, buffer) else call hdf5_write_integer_parallel(self % hdf5_grp, name_, buffer, collect_) end if -# else +#else call hdf5_write_integer(self % hdf5_grp, name_, buffer) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - write(self % unit_fh) buffer - else - call mpi_write_integer(self % mpi_fh, buffer, collect_) - end if -#else - write(self % unit_fh) buffer -#endif end subroutine write_integer @@ -971,33 +789,23 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_read_integer(self % hdf5_grp, name_, buffer) else call hdf5_read_integer_parallel(self % hdf5_grp, name_, buffer, collect_) end if -# else +#else call hdf5_read_integer(self % hdf5_grp, name_, buffer) -# endif +#endif ! Check if HDf5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - read(self % unit_fh) buffer - else - call mpi_read_integer(self % mpi_fh, buffer, collect_) - end if -#else - read(self % unit_fh) buffer -#endif end subroutine read_integer @@ -1033,34 +841,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_write_integer_1Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_write_integer_1Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else call hdf5_write_integer_1Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - write(self % unit_fh) buffer(1:length) - else - call mpi_write_integer_1Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - write(self % unit_fh) buffer(1:length) -#endif end subroutine write_integer_1Darray @@ -1096,35 +894,25 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_read_integer_1Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_read_integer_1Darray_parallel(self % hdf5_grp, name_, buffer, & length, collect_) end if -# else +#else ! Read the data in serial call hdf5_read_integer_1Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - read(self % unit_fh) buffer(1:length) - else - call mpi_read_integer_1Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - read(self % unit_fh) buffer(1:length) -#endif end subroutine read_integer_1Darray @@ -1160,34 +948,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_write_integer_2Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_write_integer_2Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else call hdf5_write_integer_2Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - write(self % unit_fh) buffer(1:length(1),1:length(2)) - else - call mpi_write_integer_2Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - write(self % unit_fh) buffer(1:length(1),1:length(2)) -#endif end subroutine write_integer_2Darray @@ -1223,34 +1001,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_read_integer_2Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_read_integer_2Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else call hdf5_read_integer_2Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - read(self % unit_fh) buffer(1:length(1),1:length(2)) - else - call mpi_read_integer_2Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - read(self % unit_fh) buffer(1:length(1),1:length(2)) -#endif end subroutine read_integer_2Darray @@ -1286,34 +1054,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_write_integer_3Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_write_integer_3Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else call hdf5_write_integer_3Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) - else - call mpi_write_integer_3Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) -#endif end subroutine write_integer_3Darray @@ -1349,34 +1107,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_read_integer_3Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_read_integer_3Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else call hdf5_read_integer_3Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) - else - call mpi_read_integer_3Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3)) -#endif end subroutine read_integer_3Darray @@ -1413,36 +1161,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_write_integer_4Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_write_integer_4Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else call hdf5_write_integer_4Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & - 1:length(4)) - else - call mpi_write_integer_4Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - write(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & - 1:length(4)) -#endif end subroutine write_integer_4Darray @@ -1479,36 +1215,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_read_integer_4Darray(self % hdf5_grp, name_, buffer, length) else call hdf5_read_integer_4Darray_parallel(self % hdf5_grp, name_, buffer, length, & collect_) end if -# else +#else call hdf5_read_integer_4Darray(self % hdf5_grp, name_, buffer, length) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & - 1:length(4)) - else - call mpi_read_integer_4Darray(self % mpi_fh, buffer, length, collect_) - end if -#else - read(self % unit_fh) buffer(1:length(1),1:length(2),1:length(3), & - 1:length(4)) -#endif end subroutine read_integer_4Darray @@ -1543,34 +1267,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_write_long(self % hdf5_grp, name_, buffer, hdf5_integer8_t) else call hdf5_write_long_parallel(self % hdf5_grp, name_, buffer, & hdf5_integer8_t, collect_) end if -# else +#else call hdf5_write_long(self % hdf5_grp, name_, buffer, hdf5_integer8_t) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - write(self % unit_fh) buffer - else - call mpi_write_long(self % mpi_fh, buffer, collect_) - end if -#else - write(self % unit_fh) buffer -#endif end subroutine write_long @@ -1605,34 +1319,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_read_long(self % hdf5_grp, name_, buffer, hdf5_integer8_t) else call hdf5_read_long_parallel(self % hdf5_grp, name_, buffer, & hdf5_integer8_t, collect_) end if -# else +#else call hdf5_read_long(self % hdf5_grp, name_, buffer, hdf5_integer8_t) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - read(self % unit_fh) buffer - else - call mpi_read_long(self % mpi_fh, buffer, collect_) - end if -#else - read(self % unit_fh) buffer -#endif end subroutine read_long @@ -1671,34 +1375,24 @@ contains collect_ = .true. end if -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_write_string(self % hdf5_grp, name_, buffer, n) else call hdf5_write_string_parallel(self % hdf5_grp, name_, buffer, n, collect_) end if -# else +#else ! Write the data call hdf5_write_string(self % hdf5_grp, name_, buffer, n) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - write(self % unit_fh) buffer - else - call mpi_write_string(self % mpi_fh, buffer, n, collect_) - end if -#else - write(self % unit_fh) buffer -#endif end subroutine write_string @@ -1737,34 +1431,23 @@ contains collect_ = .true. end if - -#ifdef HDF5 ! Check if HDF5 group should be created/opened if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) else self % hdf5_grp = self % hdf5_fh endif -# ifdef MPI +#ifdef MPI if (self % serial) then call hdf5_read_string(self % hdf5_grp, name_, buffer, n) else call hdf5_read_string_parallel(self % hdf5_grp, name_, buffer, n, collect_) end if -# else +#else call hdf5_read_string(self % hdf5_grp, name_, buffer, n) -# endif +#endif ! Check if HDF5 group should be closed if (present(group)) call hdf5_close_group(self % hdf5_grp) -#elif MPI - if (self % serial) then - read(self % unit_fh) buffer - else - call mpi_read_string(self % mpi_fh, buffer, n, collect_) - end if -#else - read(self % unit_fh) buffer -#endif end subroutine read_string @@ -1772,7 +1455,6 @@ contains ! WRITE_ATTRIBUTE_STRING !=============================================================================== -#ifdef HDF5 subroutine write_attribute_string(self, var, attr_type, attr_str, group) character(*), intent(in) :: var ! variable name for attr @@ -1795,7 +1477,6 @@ contains if (present(group)) call hdf5_close_group(self % hdf5_grp) end subroutine write_attribute_string -#endif !=============================================================================== ! WRITE_TALLY_RESULT writes an OpenMC TallyResult type @@ -1812,10 +1493,6 @@ contains character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name -#ifndef HDF5 - integer :: j,k ! iteration counters -#endif - ! Set name name_ = trim(name) @@ -1824,8 +1501,6 @@ contains group_ = trim(group) end if -#ifdef HDF5 - ! Open up sub-group if present if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) @@ -1854,18 +1529,6 @@ contains call hdf5_close_group(self % hdf5_grp) end if -#else - - ! Write out tally buffer - do k = 1, n2 - do j = 1, n1 - write(self % unit_fh) buffer(j,k) % sum - write(self % unit_fh) buffer(j,k) % sum_sq - end do - end do - -#endif - end subroutine write_tally_result !=============================================================================== @@ -1883,12 +1546,6 @@ contains character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name -#ifndef HDF5 -# ifndef MPI - integer :: j,k ! iteration counters -# endif -#endif - ! Set name name_ = trim(name) @@ -1897,8 +1554,6 @@ contains group_ = trim(group) end if -#ifdef HDF5 - ! Open up sub-group if present if (present(group)) then call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) @@ -1917,24 +1572,6 @@ contains call h5dclose_f(dset, hdf5_err) if (present(group)) call hdf5_close_group(self % hdf5_grp) -# elif MPI - - ! Write out tally buffer - call MPI_FILE_READ(self % mpi_fh, buffer, n1*n2, MPI_TALLYRESULT, & - MPI_STATUS_IGNORE, mpiio_err) - -#else - - ! Read tally result - do k = 1, n2 - do j = 1, n1 - read(self % unit_fh) buffer(j,k) % sum - read(self % unit_fh) buffer(j,k) % sum_sq - end do - end do - -#endif - end subroutine read_tally_result !=============================================================================== @@ -1946,21 +1583,9 @@ contains class(BinaryOutput) :: self #ifdef MPI -# ifndef HDF5 - integer(MPI_OFFSET_KIND) :: offset ! offset of data - integer :: size_bank ! size of bank to write -#ifdef MPIF08 - type(MPI_Datatype) :: datatype -#else - integer :: datatype -#endif -# endif -# ifdef HDF5 - integer(8) :: offset(1) ! source data offset -# endif + integer(8) :: offset(1) ! source data offset #endif -#ifdef HDF5 #ifdef MPI ! Set size of total dataspace for all procs and rank @@ -2005,7 +1630,7 @@ contains call h5dclose_f(dset, hdf5_err) call h5pclose_f(plist, hdf5_err) -# else +#else ! Set size dims1(1) = work @@ -2028,31 +1653,6 @@ contains 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(self % mpi_fh, offset, mpiio_err) - - ! Determine offset on master process and broadcast to all processors - call MPI_TYPE_MATCH_SIZE(MPI_TYPECLASS_INTEGER, MPI_OFFSET_KIND, & - datatype, mpi_err) - call MPI_BCAST(offset, 1, datatype, 0, MPI_COMM_WORLD, mpi_err) - - ! Set the proper offset for source data on this processor - call MPI_TYPE_SIZE(MPI_BANK, size_bank, mpi_err) - offset = offset + size_bank*work_index(rank) - - ! Write all source sites - call MPI_FILE_WRITE_AT(self % mpi_fh, offset, source_bank(1), int(work), & - MPI_BANK, MPI_STATUS_IGNORE, mpiio_err) - -#else - - ! Write out source sites - write(self % unit_fh) source_bank - #endif end subroutine write_source_bank @@ -2066,17 +1666,10 @@ contains class(BinaryOutput) :: self #ifdef MPI -# ifndef HDF5 - integer(MPI_OFFSET_KIND) :: offset ! offset of data - integer :: size_bank ! size of bank to read -# endif -# ifdef HDF5 - integer(8) :: offset(1) ! offset of data -# endif + integer(8) :: offset(1) ! offset of data #endif -#ifdef HDF5 -# ifdef MPI +#ifdef MPI ! Set size of total dataspace for all procs and rank dims1(1) = n_particles @@ -2114,7 +1707,7 @@ contains call h5dclose_f(dset, hdf5_err) call h5pclose_f(plist, hdf5_err) -# else +#else ! Open dataset call h5dopen_f(self % hdf5_fh, "source_bank", dset, hdf5_err) @@ -2128,36 +1721,6 @@ contains ! Close all ids call h5dclose_f(dset, hdf5_err) -# endif - -#elif MPI - - ! Go to the end of the file to set file pointer - offset = 0 - call MPI_FILE_SEEK(self % mpi_fh, offset, MPI_SEEK_END, & - mpiio_err) - - ! Get current offset (will be at EOF) - call MPI_FILE_GET_POSITION(self % mpi_fh, offset, mpiio_err) - - ! Get the size of the source bank on all procs - call MPI_TYPE_SIZE(MPI_BANK, size_bank, mpi_err) - - ! Calculate offset where the source bank will begin - offset = offset - n_particles*size_bank - - ! Set the proper offset for source data on this processor - offset = offset + size_bank*work_index(rank) - - ! Write all source sites - call MPI_FILE_READ_AT(self % mpi_fh, offset, source_bank(1), int(work), & - MPI_BANK, MPI_STATUS_IGNORE, mpiio_err) - -#else - - ! Write out source sites - read(self % unit_fh) source_bank - #endif end subroutine read_source_bank diff --git a/src/particle_restart_write.F90 b/src/particle_restart_write.F90 index f138a6740..48b4af661 100644 --- a/src/particle_restart_write.F90 +++ b/src/particle_restart_write.F90 @@ -32,11 +32,7 @@ contains ! Set up file name filename = trim(path_output) // 'particle_' // trim(to_str(current_batch)) & // '_' // trim(to_str(p % id)) -#ifdef HDF5 filename = trim(filename) // '.h5' -#else - filename = trim(filename) // '.binary' -#endif !$omp critical (WriteParticleRestart) ! Create file diff --git a/src/source.F90 b/src/source.F90 index e82482915..4b0de58b5 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -79,11 +79,7 @@ contains ! Write out initial source if (write_initial_source) then call write_message('Writing out initial source...', 1) -#ifdef HDF5 filename = trim(path_output) // 'initial_source.h5' -#else - filename = trim(path_output) // 'initial_source.binary' -#endif call sp % file_create(filename, serial = .false.) call sp % write_source_bank() call sp % file_close() diff --git a/src/state_point.F90 b/src/state_point.F90 index 6b983231f..790fd58c5 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -55,11 +55,7 @@ contains & zero_padded(current_batch, count_digits(n_max_batches)) ! Append appropriate extension -#ifdef HDF5 filename = trim(filename) // '.h5' -#else - filename = trim(filename) // '.binary' -#endif ! Write message call write_message("Creating state point " // trim(filename) // "...", 1) @@ -118,10 +114,8 @@ contains ! Write out CMFD info if (cmfd_on) then -#ifdef HDF5 call sp % open_group("cmfd") call sp % close_group() -#endif call sp % write_data(1, "cmfd_on") call sp % write_data(cmfd % indices, "indices", length=4, group="cmfd") call sp % write_data(cmfd % k_cmfd, "k_cmfd", length=current_batch, & @@ -143,10 +137,8 @@ contains end if end if -#ifdef HDF5 call sp % open_group("tallies") call sp % close_group() -#endif ! Write number of meshes call sp % write_data(n_meshes, "n_meshes", group="tallies/meshes") @@ -414,11 +406,7 @@ contains filename = trim(path_output) // 'source.' // & & zero_padded(current_batch, count_digits(n_max_batches)) -#ifdef HDF5 filename = trim(filename) // '.h5' -#else - filename = trim(filename) // '.binary' -#endif ! Write message for new file creation call write_message("Creating source file " // trim(filename) // "...", & @@ -434,12 +422,8 @@ contains ! Set filename for state point filename = trim(path_output) // 'statepoint.' // & - & zero_padded(current_batch, count_digits(n_max_batches)) -#ifdef HDF5 + zero_padded(current_batch, count_digits(n_max_batches)) filename = trim(filename) // '.h5' -#else - filename = trim(filename) // '.binary' -#endif ! Reopen statepoint file in parallel call sp % file_open(filename, 'w', serial = .false.) @@ -456,14 +440,9 @@ contains ! Also check to write source separately in overwritten file if (source_latest) then - ! Set filename filename = trim(path_output) // 'source' -#ifdef HDF5 filename = trim(filename) // '.h5' -#else - filename = trim(filename) // '.binary' -#endif ! Write message for new file creation call write_message("Creating source file " // trim(filename) // "...", 1) diff --git a/src/track_output.F90 b/src/track_output.F90 index 6ab514cdb..d3716e9b0 100644 --- a/src/track_output.F90 +++ b/src/track_output.F90 @@ -95,15 +95,9 @@ contains integer, allocatable :: n_coords(:) integer :: n_particle_tracks -#ifdef HDF5 fname = trim(path_output) // 'track_' // trim(to_str(current_batch)) & // '_' // trim(to_str(current_gen)) // '_' // trim(to_str(p % id)) & // '.h5' -#else - fname = trim(path_output) // 'track_' // trim(to_str(current_batch)) & - // '_' // trim(to_str(current_gen)) // '_' // trim(to_str(p % id)) & - // '.binary' -#endif ! Determine total number of particles and number of coordinates for each n_particle_tracks = size(tracks) From d1139cbedcd8624cefae3140d70f606581e21a6a Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 16 Jul 2015 21:58:17 +0400 Subject: [PATCH 04/32] Remove non-HDF5 configurations from tests --- CMakeLists.txt | 56 +++++++++-------------------------- tests/run_tests.py | 63 ++++++++++++++-------------------------- tests/testing_harness.py | 16 +++++----- tests/travis.sh | 4 +-- 4 files changed, 44 insertions(+), 95 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index e4452d323..7d4dfde7f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -39,20 +39,12 @@ add_definitions(-DMAX_COORD=${maxcoord}) #=============================================================================== set(MPI_ENABLED FALSE) -set(HDF5_ENABLED FALSE) -if($ENV{FC} MATCHES "mpi[^/]*$") - message("-- Detected MPI wrapper: $ENV{FC}") - add_definitions(-DMPI) - set(MPI_ENABLED TRUE) -elseif($ENV{FC} MATCHES "h5fc$") +if($ENV{FC} MATCHES "h5fc$") message("-- Detected HDF5 wrapper: $ENV{FC}") - add_definitions(-DHDF5) - set(HDF5_ENABLED TRUE) elseif($ENV{FC} MATCHES "h5pfc$") message("-- Detected parallel HDF5 wrapper: $ENV{FC}") - add_definitions(-DMPI -DHDF5) + add_definitions(-DMPI) set(MPI_ENABLED TRUE) - set(HDF5_ENABLED TRUE) endif() # Check for Fortran 2008 MPI interface @@ -332,38 +324,18 @@ foreach(test ${TESTS}) # If a restart test is encounted, need to run with -r and restart file(s) elseif(${test} MATCHES "restart") - # Set restart file names - if (${HDF5_ENABLED}) - - # Handle restart tests separately - if(${test} MATCHES "test_statepoint_restart") - set(RESTART_FILE statepoint.07.h5) - elseif(${test} MATCHES "test_sourcepoint_restart") - set(RESTART_FILE statepoint.07.h5 source.07.h5) - elseif(${test} MATCHES "test_particle_restart_eigval") - set(RESTART_FILE particle_9_555.h5) - elseif(${test} MATCHES "test_particle_restart_fixed") - set(RESTART_FILE particle_7_928.h5) - else(${test} MATCHES "test_statepoint_restart") - message(FATAL_ERROR "Restart test ${test} not recognized") - endif(${test} MATCHES "test_statepoint_restart") - - else(${HDF5_ENABLED}) - - # Handle restart tests separately - if(${test} MATCHES "test_statepoint_restart") - set(RESTART_FILE statepoint.07.binary) - elseif(${test} MATCHES "test_sourcepoint_restart") - set(RESTART_FILE statepoint.07.binary source.07.binary) - elseif(${test} MATCHES "test_particle_restart_eigval") - set(RESTART_FILE particle_9_555.binary) - elseif(${test} MATCHES "test_particle_restart_fixed") - set(RESTART_FILE particle_7_6144.binary) - else(${test} MATCHES "test_statepoint_restart") - message(FATAL_ERROR "Restart test ${test} not recognized") - endif(${test} MATCHES "test_statepoint_restart") - - endif(${HDF5_ENABLED}) + # Handle restart tests separately + if(${test} MATCHES "test_statepoint_restart") + set(RESTART_FILE statepoint.07.h5) + elseif(${test} MATCHES "test_sourcepoint_restart") + set(RESTART_FILE statepoint.07.h5 source.07.h5) + elseif(${test} MATCHES "test_particle_restart_eigval") + set(RESTART_FILE particle_9_555.h5) + elseif(${test} MATCHES "test_particle_restart_fixed") + set(RESTART_FILE particle_7_928.h5) + else(${test} MATCHES "test_statepoint_restart") + message(FATAL_ERROR "Restart test ${test} not recognized") + endif(${test} MATCHES "test_statepoint_restart") # Perform serial valgrind and coverage test add_test(NAME ${TEST_NAME} diff --git a/tests/run_tests.py b/tests/run_tests.py index 3550ad7cb..aa2eb14cf 100755 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -107,13 +107,12 @@ tests = OrderedDict() class Test(object): def __init__(self, name, debug=False, optimize=False, mpi=False, openmp=False, - hdf5=False, valgrind=False, coverage=False): + valgrind=False, coverage=False): self.name = name self.debug = debug self.optimize = optimize self.mpi = mpi self.openmp = openmp - self.hdf5 = hdf5 self.valgrind = valgrind self.coverage = coverage self.success = True @@ -124,15 +123,11 @@ class Test(object): self.cmake = ['cmake', '-H..', '-Bbuild', '-DPYTHON_EXECUTABLE=' + sys.executable] - # Check for MPI/HDF5 - if self.mpi and not self.hdf5: - self.fc = MPI_DIR+'/bin/mpif90' - elif not self.mpi and self.hdf5: - self.fc = HDF5_DIR+'/bin/h5fc' - elif self.mpi and self.hdf5: - self.fc = PHDF5_DIR+'/bin/h5pfc' + # Check for MPI + if self.mpi: + self.fc = PHDF5_DIR + '/bin/h5pfc' else: - self.fc = FC + self.fc = HDF5_DIR + '/bin/h5fc' # Sets the build name that will show up on the CDash def get_build_name(self): @@ -263,41 +258,26 @@ class Test(object): # Simple function to add a test to the global tests dictionary def add_test(name, debug=False, optimize=False, mpi=False, openmp=False,\ - hdf5=False, valgrind=False, coverage=False): - tests.update({name: Test(name, debug, optimize, mpi, openmp, hdf5, + valgrind=False, coverage=False): + tests.update({name: Test(name, debug, optimize, mpi, openmp, valgrind, coverage)}) # List of all tests that may be run. User can add -C to command line to specify # a subset of these configurations -add_test('basic-normal') -add_test('basic-debug', debug=True) -add_test('basic-optimize', optimize=True) -add_test('omp-normal', openmp=True) -add_test('omp-debug', openmp=True, debug=True) -add_test('omp-optimize', openmp=True, optimize=True) -add_test('hdf5-normal', hdf5=True) -add_test('hdf5-debug', hdf5=True, debug=True) -add_test('hdf5-optimize', hdf5=True, optimize=True) -add_test('omp-hdf5-normal', openmp=True, hdf5=True) -add_test('omp-hdf5-debug', openmp=True, hdf5=True, debug=True) -add_test('omp-hdf5-optimize', openmp=True, hdf5=True, optimize=True) -add_test('mpi-normal', mpi=True) -add_test('mpi-debug', mpi=True, debug=True) -add_test('mpi-optimize', mpi=True, optimize=True) -add_test('mpi-omp-normal', mpi=True, openmp=True) -add_test('mpi-omp-debug', mpi=True, openmp=True, debug=True) -add_test('mpi-omp-optimize', mpi=True, openmp=True, optimize=True) -add_test('phdf5-normal', mpi=True, hdf5=True) -add_test('phdf5-debug', mpi=True, hdf5=True, debug=True) -add_test('phdf5-optimize', mpi=True, hdf5=True, optimize=True) -add_test('phdf5-omp-normal', mpi=True, hdf5=True, openmp=True) -add_test('phdf5-omp-debug', mpi=True, hdf5=True, openmp=True, debug=True) -add_test('phdf5-omp-optimize', mpi=True, hdf5=True, openmp=True, optimize=True) -add_test('basic-debug_valgrind', debug=True, valgrind=True) -add_test('hdf5-debug_valgrind', hdf5=True, debug=True, valgrind=True) -add_test('basic-debug_coverage', debug=True, coverage=True) -add_test('hdf5-debug_coverage', debug=True, hdf5=True, coverage=True) -add_test('mpi-debug_coverage', debug=True, mpi=True, coverage=True) +add_test('hdf5-normal') +add_test('hdf5-debug', debug=True) +add_test('hdf5-optimize', optimize=True) +add_test('omp-hdf5-normal', openmp=True) +add_test('omp-hdf5-debug', openmp=True, debug=True) +add_test('omp-hdf5-optimize', openmp=True, optimize=True) +add_test('phdf5-normal', mpi=True) +add_test('phdf5-debug', mpi=True, debug=True) +add_test('phdf5-optimize', mpi=True, optimize=True) +add_test('phdf5-omp-normal', mpi=True, openmp=True) +add_test('phdf5-omp-debug', mpi=True, openmp=True, debug=True) +add_test('phdf5-omp-optimize', mpi=True, openmp=True, optimize=True) +add_test('hdf5-debug_valgrind', debug=True, valgrind=True) +add_test('hdf5-debug_coverage', debug=True, coverage=True) # Check to see if we should just print build configuration information to user if options.list_build_configs: @@ -305,7 +285,6 @@ if options.list_build_configs: print('Configuration Name: {0}'.format(key)) print(' Debug Flags:..........{0}'.format(tests[key].debug)) print(' Optimization Flags:...{0}'.format(tests[key].optimize)) - print(' HDF5 Active:..........{0}'.format(tests[key].hdf5)) print(' MPI Active:...........{0}'.format(tests[key].mpi)) print(' OpenMP Active:........{0}'.format(tests[key].openmp)) print(' Valgrind Test:........{0}'.format(tests[key].valgrind)) diff --git a/tests/testing_harness.py b/tests/testing_harness.py index 9405db845..2059c46da 100644 --- a/tests/testing_harness.py +++ b/tests/testing_harness.py @@ -82,9 +82,8 @@ class TestHarness(object): statepoint = glob.glob(os.path.join(os.getcwd(), self._sp_name)) assert len(statepoint) == 1, 'Either multiple or no statepoint files ' \ 'exist.' - assert statepoint[0].endswith('binary') \ - or statepoint[0].endswith('h5'), \ - 'Statepoint file is not a binary or hdf5 file.' + assert statepoint[0].endswith('h5'), \ + 'Statepoint file is not a HDF5 file.' if self._tallies: assert os.path.exists(os.path.join(os.getcwd(), 'tallies.out')), \ 'Tally output file does not exist.' @@ -155,7 +154,7 @@ class HashedTestHarness(TestHarness): class PlotTestHarness(TestHarness): - """Specialized TestHarness for running OpenMC plotting tests.""" + """Specialized TestHarness for running OpenMC plotting tests.""" def __init__(self, plot_names): self._plot_names = plot_names self._opts = None @@ -199,7 +198,7 @@ class PlotTestHarness(TestHarness): class CMFDTestHarness(TestHarness): - """Specialized TestHarness for running OpenMC CMFD tests.""" + """Specialized TestHarness for running OpenMC CMFD tests.""" def _get_results(self): """Digest info in the statepoint and return as a string.""" # Read the statepoint file. @@ -233,15 +232,14 @@ class CMFDTestHarness(TestHarness): class ParticleRestartTestHarness(TestHarness): - """Specialized TestHarness for running OpenMC particle restart tests.""" + """Specialized TestHarness for running OpenMC particle restart tests.""" def _test_output_created(self): """Make sure the restart file has been created.""" particle = glob.glob(os.path.join(os.getcwd(), self._sp_name)) assert len(particle) == 1, 'Either multiple or no particle restart ' \ 'files exist.' - assert particle[0].endswith('binary') \ - or particle[0].endswith('h5'), \ - 'Particle restart file is not a binary or hdf5 file.' + assert particle[0].endswith('h5'), \ + 'Particle restart file is not a HDF5 file.' def _get_results(self): """Digest info in the statepoint and return as a string.""" diff --git a/tests/travis.sh b/tests/travis.sh index fac8d793a..af54b4ff6 100755 --- a/tests/travis.sh +++ b/tests/travis.sh @@ -5,7 +5,7 @@ set -ev # Run all debug tests ./check_source.py if [ "$TRAVIS_PULL_REQUEST" != "false" ]; then - ./run_tests.py -C "^basic-debug$|^hdf5-debug$|^mpi-omp-debug$|^phdf5-omp-debug$" -j 2 -s + ./run_tests.py -C "^hdf5-debug$|^phdf5-debug$|^phdf5-omp-debug$" -j 2 -s else - ./run_tests.py -C "^basic-debug$" -j 2 + ./run_tests.py -C "^hdf5-debug$" -j 2 fi From 4db5ff01bdccf4219943b656c7092e022f5cf7ca Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 16 Jul 2015 22:43:57 +0400 Subject: [PATCH 05/32] Remove mpiio_interface module --- src/mpiio_interface.F90 | 610 --------------------------------------- src/output_interface.F90 | 3 - 2 files changed, 613 deletions(-) delete mode 100644 src/mpiio_interface.F90 diff --git a/src/mpiio_interface.F90 b/src/mpiio_interface.F90 deleted file mode 100644 index b9652c8ae..000000000 --- a/src/mpiio_interface.F90 +++ /dev/null @@ -1,610 +0,0 @@ -module mpiio_interface - -#ifdef MPI -#ifndef HDF5 - use message_passing - - implicit none - -#ifdef MPIF08 -#define FH_TYPE type(MPI_File) -#else -#define FH_TYPE integer -#endif - - integer :: mpiio_err ! MPI error code - - ! Generic HDF5 write procedure interface - interface mpi_write_data - module procedure mpi_write_double - module procedure mpi_write_double_1Darray - module procedure mpi_write_double_2Darray - module procedure mpi_write_double_3Darray - module procedure mpi_write_double_4Darray - module procedure mpi_write_integer - module procedure mpi_write_integer_1Darray - module procedure mpi_write_integer_2Darray - module procedure mpi_write_integer_3Darray - module procedure mpi_write_integer_4Darray - module procedure mpi_write_long - module procedure mpi_write_string - end interface mpi_write_data - - ! Generic HDF5 read procedure interface - interface mpi_read_data - module procedure mpi_read_double - module procedure mpi_read_double_1Darray - module procedure mpi_read_double_2Darray - module procedure mpi_read_double_3Darray - module procedure mpi_read_double_4Darray - module procedure mpi_read_integer - module procedure mpi_read_integer_1Darray - module procedure mpi_read_integer_2Darray - module procedure mpi_read_integer_3Darray - module procedure mpi_read_integer_4Darray - module procedure mpi_read_long - module procedure mpi_read_string - end interface mpi_read_data - -contains - -!=============================================================================== -! MPI_CREATE_FILE creates a file using MPI file I/O -!=============================================================================== - - subroutine mpi_create_file(filename, fh) - - character(*), intent(in) :: filename ! name of file to create - FH_TYPE, intent(inout) :: fh ! file handle - - ! Create the file - call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, MPI_MODE_CREATE + & - MPI_MODE_WRONLY, MPI_INFO_NULL, fh, mpiio_err) - - end subroutine mpi_create_file - -!=============================================================================== -! MPI_OPEN_FILE opens a file using MPI file I/O -!=============================================================================== - - subroutine mpi_open_file(filename, fh, mode) - - character(*), intent(in) :: filename ! name of file to open - character(*), intent(in) :: mode ! open 'r' read, 'w' write - FH_TYPE, intent(inout) :: fh ! file handle - - integer :: open_mode - - ! Determine access mode - open_mode = MPI_MODE_RDONLY - if (mode == 'w') then - open_mode = ior(MPI_MODE_APPEND, MPI_MODE_WRONLY) - end if - - ! Create the file - call MPI_FILE_OPEN(MPI_COMM_WORLD, filename, & - open_mode, MPI_INFO_NULL, fh, mpiio_err) - - end subroutine mpi_open_file - -!=============================================================================== -! MPI_CLOSE_FILE closes a file using MPI file I/O -!=============================================================================== - - subroutine mpi_close_file(fh) - - FH_TYPE, intent(inout) :: fh ! file handle - - call MPI_FILE_CLOSE(fh, mpiio_err) - - end subroutine mpi_close_file - -!=============================================================================== -! MPI_WRITE_INTEGER writes integer scalar data using MPI File I/O -!=============================================================================== - - subroutine mpi_write_integer(fh, buffer, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: buffer ! data to write - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_WRITE_ALL(fh, buffer, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_WRITE(fh, buffer, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_write_integer - -!=============================================================================== -! MPI_READ_INTEGER reads integer scalar data using MPI file I/O -!=============================================================================== - - subroutine mpi_read_integer(fh, buffer, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(inout) :: buffer ! read data to here - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_READ_ALL(fh, buffer, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_READ(fh, buffer, 1, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_read_integer - -!=============================================================================== -! MPI_WRITE_INTEGER_1DARRAY writes integer 1-D array data using MPI File I/O -!=============================================================================== - - subroutine mpi_write_integer_1Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length ! length of array - integer, intent(in) :: buffer(:) ! data to write - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_WRITE_ALL(fh, buffer, length, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_WRITE(fh, buffer, length, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_write_integer_1Darray - -!=============================================================================== -! MPI_READ_INTEGER_1DARRAY reads integer 1-D array using MPI file I/O -!=============================================================================== - - subroutine mpi_read_integer_1Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length ! length of array - integer, intent(inout) :: buffer(:) ! read data to here - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_READ_ALL(fh, buffer, length, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_READ(fh, buffer, length, MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_read_integer_1Darray - -!=============================================================================== -! MPI_WRITE_INTEGER_2DARRAY writes integer 2-D array data using MPI File I/O -!=============================================================================== - - subroutine mpi_write_integer_2Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length(2) ! length of array - integer, intent(in) :: buffer(length(1),length(2)) ! data to write - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_WRITE_ALL(fh, buffer, product(length), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_WRITE(fh, buffer, product(length), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_write_integer_2Darray - -!=============================================================================== -! MPI_READ_INTEGER_2DARRAY reads integer 2-D array using MPI file I/O -!=============================================================================== - - subroutine mpi_read_integer_2Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length(2) ! length of array - integer, intent(inout) :: buffer(length(1),length(2)) ! read data to here - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_READ_ALL(fh, buffer, product(length), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_READ(fh, buffer, product(length), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_read_integer_2Darray - -!=============================================================================== -! MPI_WRITE_INTEGER_3DARRAY writes integer 3-D array data using MPI File I/O -!=============================================================================== - - subroutine mpi_write_integer_3Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length(3) ! length of array - integer, intent(in) :: buffer(length(1),length(2),& - length(3)) ! data to write - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_WRITE_ALL(fh, buffer, product(length), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_WRITE(fh, buffer, product(length), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_write_integer_3Darray - -!=============================================================================== -! MPI_READ_INTEGER_3DARRAY reads integer 3-D array using MPI file I/O -!=============================================================================== - - subroutine mpi_read_integer_3Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length(3) ! length of array - integer, intent(inout) :: buffer(length(1),length(2), & - length(3)) ! read data to here - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_READ_ALL(fh, buffer, product(length), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_READ(fh, buffer, product(length), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_read_integer_3Darray - -!=============================================================================== -! MPI_WRITE_INTEGER_4DARRAY writes integer 4-D array data using MPI File I/O -!=============================================================================== - - subroutine mpi_write_integer_4Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length(4) ! length of array - integer, intent(in) :: buffer(length(1),length(2),& - length(3),length(4)) ! data to write - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_WRITE_ALL(fh, buffer, product(length), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_WRITE(fh, buffer, product(length), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_write_integer_4Darray - -!=============================================================================== -! MPI_READ_INTEGER_4DARRAY reads integer 4-D array using MPI file I/O -!=============================================================================== - - subroutine mpi_read_integer_4Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length(4) ! length of array - integer, intent(inout) :: buffer(length(1),length(2), & - length(3),length(4)) ! read data to here - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_READ_ALL(fh, buffer, product(length), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_READ(fh, buffer, product(length), MPI_INTEGER, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_read_integer_4Darray - -!=============================================================================== -! MPI_WRITE_DOUBLE writes integer scalar data using MPI File I/O -!=============================================================================== - - subroutine mpi_write_double(fh, buffer, collect) - - FH_TYPE, intent(in) :: fh ! file handle - real(8), intent(in) :: buffer ! data to write - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_WRITE_ALL(fh, buffer, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_WRITE(fh, buffer, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_write_double - -!=============================================================================== -! MPI_READ_DOUBLE reads integer scalar data using MPI file I/O -!=============================================================================== - - subroutine mpi_read_double(fh, buffer, collect) - - FH_TYPE, intent(in) :: fh ! file handle - real(8), intent(inout) :: buffer ! read data to here - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_READ_ALL(fh, buffer, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_READ(fh, buffer, 1, MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_read_double - -!=============================================================================== -! MPI_WRITE_DOUBLE_1DARRAY writes integer 1-D array data using MPI File I/O -!=============================================================================== - - subroutine mpi_write_double_1Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length ! length of array - real(8), intent(in) :: buffer(:) ! data to write - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_WRITE_ALL(fh, buffer, length, MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_WRITE(fh, buffer, length, MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_write_double_1Darray - -!=============================================================================== -! MPI_READ_DOUBLE_1DARRAY reads integer 1-D array using MPI file I/O -!=============================================================================== - - subroutine mpi_read_double_1Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length ! length of array - real(8), intent(inout) :: buffer(:) ! read data to here - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_READ_ALL(fh, buffer, length, MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_READ(fh, buffer, length, MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_read_double_1Darray - -!=============================================================================== -! MPI_WRITE_DOUBLE_2DARRAY writes integer 2-D array data using MPI File I/O -!=============================================================================== - - subroutine mpi_write_double_2Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length(2) ! length of array - real(8), intent(in) :: buffer(length(1),length(2)) ! data to write - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_WRITE_ALL(fh, buffer, product(length), MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_WRITE(fh, buffer, product(length), MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_write_double_2Darray - -!=============================================================================== -! MPI_READ_DOUBLE_2DARRAY reads integer 2-D array using MPI file I/O -!=============================================================================== - - subroutine mpi_read_double_2Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length(2) ! length of array - real(8), intent(inout) :: buffer(length(1),length(2)) ! read data to here - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_READ_ALL(fh, buffer, product(length), MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_READ(fh, buffer, product(length), MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_read_double_2Darray - -!=============================================================================== -! MPI_WRITE_DOUBLE_3DARRAY writes integer 3-D array data using MPI File I/O -!=============================================================================== - - subroutine mpi_write_double_3Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length(3) ! length of array - real(8), intent(in) :: buffer(length(1),length(2),& - length(3)) ! data to write - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_WRITE_ALL(fh, buffer, product(length), MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_WRITE(fh, buffer, product(length), MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_write_double_3Darray - -!=============================================================================== -! MPI_READ_DOUBLE_3DARRAY reads integer 3-D array using MPI file I/O -!=============================================================================== - - subroutine mpi_read_double_3Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length(3) ! length of array - real(8), intent(inout) :: buffer(length(1),length(2), & - length(3)) ! read data to here - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_READ_ALL(fh, buffer, product(length), MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_READ(fh, buffer, product(length), MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_read_double_3Darray - -!=============================================================================== -! MPI_WRITE_DOUBLE_4DARRAY writes integer 4-D array data using MPI File I/O -!=============================================================================== - - subroutine mpi_write_double_4Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length(4) ! length of array - real(8), intent(in) :: buffer(length(1),length(2),& - length(3),length(4)) ! data to write - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_WRITE_ALL(fh, buffer, product(length), MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_WRITE(fh, buffer, product(length), MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_write_double_4Darray - -!=============================================================================== -! MPI_READ_DOUBLE_4DARRAY reads integer 4-D array using MPI file I/O -!=============================================================================== - - subroutine mpi_read_double_4Darray(fh, buffer, length, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length(4) ! length of array - real(8), intent(inout) :: buffer(length(1),length(2), & - length(3),length(4)) ! read data to here - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_READ_ALL(fh, buffer, product(length), MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_READ(fh, buffer, product(length), MPI_REAL8, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_read_double_4Darray - -!=============================================================================== -! MPI_WRITE_LONG writes long integer scalar data using MPI file I/O -!=============================================================================== - - subroutine mpi_write_long(fh, buffer, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer(8), intent(in) :: buffer ! data to write - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_WRITE_ALL(fh, buffer, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_WRITE(fh, buffer, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_write_long - -!=============================================================================== -! MPI_READ_LONG reads long integer scalar data using MPI file I/O -!=============================================================================== - - subroutine mpi_read_long(fh, buffer, collect) - - FH_TYPE, intent(in) :: fh ! file handle - integer(8), intent(inout) :: buffer ! read data to here - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_READ_ALL(fh, buffer, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_READ(fh, buffer, 1, MPI_INTEGER8, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_read_long - -!=============================================================================== -! MPI_WRITE_STRING writes string data using MPI file I/O -!=============================================================================== - - subroutine mpi_write_string(fh, buffer, length, collect) - - character(*), intent(in) :: buffer ! data to write - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length ! length of data - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_WRITE_ALL(fh, buffer, length, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_WRITE(fh, buffer, length, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_write_string - -!=============================================================================== -! MPI_READ_STRING reads string data using MPI file I/O -!=============================================================================== - - subroutine mpi_read_string(fh, buffer, length, collect) - - character(*), intent(inout) :: buffer ! read data to here - FH_TYPE, intent(in) :: fh ! file handle - integer, intent(in) :: length ! length of string - logical, intent(in) :: collect ! collective I/O - - if (collect) then - call MPI_FILE_READ_ALL(fh, buffer, length, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpiio_err) - else - call MPI_FILE_READ(fh, buffer, length, MPI_CHARACTER, & - MPI_STATUS_IGNORE, mpiio_err) - end if - - end subroutine mpi_read_string - -#endif -#endif -end module mpiio_interface diff --git a/src/output_interface.F90 b/src/output_interface.F90 index f56a4b339..7ced3c052 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -6,9 +6,6 @@ module output_interface use tally_header, only: TallyResult use hdf5_interface -#ifdef MPI - use mpiio_interface -#endif implicit none private From 3c1ba76f95617b7d2d7ad5ad56ccee246187d7a3 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Mon, 31 Aug 2015 11:13:21 +0700 Subject: [PATCH 06/32] Rely on FindHDF5 rather than h5fc and h5pfc scripts The FindHDF5.cmake packaged with CMake is broken in a number of respects. The HL components don't work (debian has a patch in cmake-data). It's also impossible to prefer a parallel installation if both h5fc and h5pfc appear on your PATH. Finally, hdf5_hl is not included in the list of libraries needed for the Fortran_HL component. A local version of FindHDF5 is used here which fixes all these issues. This enables one to compile OpenMC with MPI + serial HDF5 if needed by introducing the PHDF5 preprocessor flag. --- CMakeLists.txt | 48 ++++- cmake/Modules/FindHDF5.cmake | 407 +++++++++++++++++++++++++++++++++++ src/hdf5_interface.F90 | 12 +- src/output_interface.F90 | 60 +++--- tests/run_tests.py | 34 ++- 5 files changed, 508 insertions(+), 53 deletions(-) create mode 100644 cmake/Modules/FindHDF5.cmake diff --git a/CMakeLists.txt b/CMakeLists.txt index 7d4dfde7f..623eb0dcb 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,6 +7,9 @@ set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib) set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin) set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include) +# Set module path +set(CMAKE_MODULE_PATH ${CMAKE_CURRENT_SOURCE_DIR}/cmake/Modules) + # Make sure Fortran module directory is included when building include_directories(${CMAKE_BINARY_DIR}/include) @@ -35,14 +38,12 @@ set(maxcoord 10 CACHE STRING "Maximum number of nested coordinate levels") add_definitions(-DMAX_COORD=${maxcoord}) #=============================================================================== -# MPI for distributed-memory parallelism / HDF5 for binary output +# MPI for distributed-memory parallelism #=============================================================================== set(MPI_ENABLED FALSE) -if($ENV{FC} MATCHES "h5fc$") - message("-- Detected HDF5 wrapper: $ENV{FC}") -elseif($ENV{FC} MATCHES "h5pfc$") - message("-- Detected parallel HDF5 wrapper: $ENV{FC}") +if($ENV{FC} MATCHES "mpi[^/]*$") + message("-- Detected MPI wrapper: $ENV{FC}") add_definitions(-DMPI) set(MPI_ENABLED TRUE) endif() @@ -53,6 +54,33 @@ if(MPI_ENABLED AND mpif08) add_definitions(-DMPIF08) endif() +#=============================================================================== +# HDF5 for binary output +#=============================================================================== + +# Unfortunately FindHDF5.cmake will always prefer a serial HDF5 installation +# over a parallel installation if both appear on the user's PATH. To get around +# this, we check for the environment variable HDF5_ROOT and if it exists, use it +# to check whether its a parallel version. + +if(DEFINED ENV{HDF5_ROOT} AND EXISTS $ENV{HDF5_ROOT}/bin/h5pcc) + set(HDF5_PREFER_PARALLEL TRUE) +else() + set(HDF5_PREFER_PARALLEL FALSE) +endif() + +find_package(HDF5 COMPONENTS Fortran_HL) +if(NOT HDF5_FOUND) + message(FATAL_ERROR "Could not find HDF5") +endif() +if(HDF5_IS_PARALLEL) + if(NOT MPI_ENABLED) + message(FATAL_ERROR "Parallel HDF5 must be used with MPI.") + endif() + add_definitions(-DPHDF5) + message("-- Using parallel HDF5") +endif() + #=============================================================================== # Set compile/link flags based on which compiler is being used #=============================================================================== @@ -212,6 +240,14 @@ set(program "openmc") file(GLOB source src/*.F90 src/xml/openmc_fox.F90) add_executable(${program} ${source}) +# target_include_directories was added in CMake 2.8.11 and is the recommended +# way to set include directories. For lesser versions, we revert to set_property +if(CMAKE_VERSION VERSION_LESS 2.8.11) + include_directories(${HDF5_INCLUDE_DIRS}) +else() + target_include_directories(${program} PUBLIC ${HDF5_INCLUDE_DIRS}) +endif() + # target_compile_options was added in CMake 2.8.12 and is the recommended way to # set compile flags. Note that this sets the COMPILE_OPTIONS property (also # available only in 2.8.12+) rather than the COMPILE_FLAGS property, which is @@ -225,7 +261,7 @@ endif() # target_link_libraries treats any arguments starting with - but not -l as # linker flags. Thus, we can pass both linker flags and libraries together. -target_link_libraries(${program} ${ldflags} ${libraries} fox_dom) +target_link_libraries(${program} ${ldflags} ${HDF5_LIBRARIES} fox_dom) #=============================================================================== # Install executable, scripts, manpage, license diff --git a/cmake/Modules/FindHDF5.cmake b/cmake/Modules/FindHDF5.cmake new file mode 100644 index 000000000..1631f0193 --- /dev/null +++ b/cmake/Modules/FindHDF5.cmake @@ -0,0 +1,407 @@ +#.rst: +# FindHDF5 +# -------- +# +# Find HDF5, a library for reading and writing self describing array data. +# +# +# +# This module invokes the HDF5 wrapper compiler that should be installed +# alongside HDF5. Depending upon the HDF5 Configuration, the wrapper +# compiler is called either h5cc or h5pcc. If this succeeds, the module +# will then call the compiler with the -show argument to see what flags +# are used when compiling an HDF5 client application. +# +# The module will optionally accept the COMPONENTS argument. If no +# COMPONENTS are specified, then the find module will default to finding +# only the HDF5 C library. If one or more COMPONENTS are specified, the +# module will attempt to find the language bindings for the specified +# components. The only valid components are C, CXX, Fortran, HL, and +# Fortran_HL. If the COMPONENTS argument is not given, the module will +# attempt to find only the C bindings. +# +# On UNIX systems, this module will read the variable +# HDF5_USE_STATIC_LIBRARIES to determine whether or not to prefer a +# static link to a dynamic link for HDF5 and all of it's dependencies. +# To use this feature, make sure that the HDF5_USE_STATIC_LIBRARIES +# variable is set before the call to find_package. +# +# To provide the module with a hint about where to find your HDF5 +# installation, you can set the environment variable HDF5_ROOT. The +# Find module will then look in this path when searching for HDF5 +# executables, paths, and libraries. +# +# In addition to finding the includes and libraries required to compile +# an HDF5 client application, this module also makes an effort to find +# tools that come with the HDF5 distribution that may be useful for +# regression testing. +# +# This module will define the following variables: +# +# :: +# +# HDF5_INCLUDE_DIRS - Location of the hdf5 includes +# HDF5_INCLUDE_DIR - Location of the hdf5 includes (deprecated) +# HDF5_DEFINITIONS - Required compiler definitions for HDF5 +# HDF5_C_LIBRARIES - Required libraries for the HDF5 C bindings. +# HDF5_CXX_LIBRARIES - Required libraries for the HDF5 C++ bindings +# HDF5_Fortran_LIBRARIES - Required libraries for the HDF5 Fortran bindings +# HDF5_HL_LIBRARIES - Required libraries for the HDF5 high level API +# HDF5_Fortran_HL_LIBRARIES - Required libraries for the high level Fortran +# bindings. +# HDF5_LIBRARIES - Required libraries for all requested bindings +# HDF5_FOUND - true if HDF5 was found on the system +# HDF5_VERSION - HDF5 version in format Major.Minor.Release +# HDF5_LIBRARY_DIRS - the full set of library directories +# HDF5_IS_PARALLEL - Whether or not HDF5 was found with parallel IO support +# HDF5_C_COMPILER_EXECUTABLE - the path to the HDF5 C wrapper compiler +# HDF5_CXX_COMPILER_EXECUTABLE - the path to the HDF5 C++ wrapper compiler +# HDF5_Fortran_COMPILER_EXECUTABLE - the path to the HDF5 Fortran wrapper compiler +# HDF5_DIFF_EXECUTABLE - the path to the HDF5 dataset comparison tool + +#============================================================================= +# Copyright 2015 Axel Huebl, Helmholtz-Zentrum Dresden - Rossendorf +# Copyright 2009 Kitware, Inc. +# +# Distributed under the OSI-approved BSD License (the "License"); +# see accompanying file Copyright.txt for details. +# +# This software is distributed WITHOUT ANY WARRANTY; without even the +# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# See the License for more information. +#============================================================================= +# (To distribute this file outside of CMake, substitute the full +# License text for the above reference.) + +# This module is maintained by Will Dicharry . + +include(SelectLibraryConfigurations) +include(FindPackageHandleStandardArgs) + +# List of the valid HDF5 components +set( HDF5_VALID_COMPONENTS + C + CXX + Fortran + HL + Fortran_HL +) + +# Validate the list of find components. +if( NOT HDF5_FIND_COMPONENTS ) + set( HDF5_LANGUAGE_BINDINGS "C" ) +else() + # add the extra specified components, ensuring that they are valid. + foreach( component ${HDF5_FIND_COMPONENTS} ) + list( FIND HDF5_VALID_COMPONENTS ${component} component_location ) + if( ${component_location} EQUAL -1 ) + message( FATAL_ERROR + "\"${component}\" is not a valid HDF5 component." ) + else() + list( APPEND HDF5_LANGUAGE_BINDINGS ${component} ) + endif() + endforeach() +endif() + +if(HDF5_PREFER_PARALLEL) + # try to find the HDF5 wrapper compilers + find_program( HDF5_C_COMPILER_EXECUTABLE + NAMES h5pcc h5cc + HINTS ENV HDF5_ROOT + PATH_SUFFIXES bin Bin + DOC "HDF5 Wrapper compiler. Used only to detect HDF5 compile flags." ) + mark_as_advanced( HDF5_C_COMPILER_EXECUTABLE ) + + find_program( HDF5_CXX_COMPILER_EXECUTABLE + NAMES h5pc++ h5c++ + HINTS ENV HDF5_ROOT + PATH_SUFFIXES bin Bin + DOC "HDF5 C++ Wrapper compiler. Used only to detect HDF5 compile flags." ) + mark_as_advanced( HDF5_CXX_COMPILER_EXECUTABLE ) + + find_program( HDF5_Fortran_COMPILER_EXECUTABLE + NAMES h5pfc h5fc + HINTS ENV HDF5_ROOT + PATH_SUFFIXES bin Bin + DOC "HDF5 Fortran Wrapper compiler. Used only to detect HDF5 compile flags." ) + mark_as_advanced( HDF5_Fortran_COMPILER_EXECUTABLE ) +else() + # try to find the HDF5 wrapper compilers + find_program( HDF5_C_COMPILER_EXECUTABLE + NAMES h5cc h5pcc + HINTS ENV HDF5_ROOT + PATH_SUFFIXES bin Bin + DOC "HDF5 Wrapper compiler. Used only to detect HDF5 compile flags." ) + mark_as_advanced( HDF5_C_COMPILER_EXECUTABLE ) + + find_program( HDF5_CXX_COMPILER_EXECUTABLE + NAMES h5c++ h5pc++ + HINTS ENV HDF5_ROOT + PATH_SUFFIXES bin Bin + DOC "HDF5 C++ Wrapper compiler. Used only to detect HDF5 compile flags." ) + mark_as_advanced( HDF5_CXX_COMPILER_EXECUTABLE ) + + find_program( HDF5_Fortran_COMPILER_EXECUTABLE + NAMES h5fc h5pfc + HINTS ENV HDF5_ROOT + PATH_SUFFIXES bin Bin + DOC "HDF5 Fortran Wrapper compiler. Used only to detect HDF5 compile flags." ) + mark_as_advanced( HDF5_Fortran_COMPILER_EXECUTABLE ) +endif() + +find_program( HDF5_DIFF_EXECUTABLE + NAMES h5diff + HINTS ENV HDF5_ROOT + PATH_SUFFIXES bin Bin + DOC "HDF5 file differencing tool." ) +mark_as_advanced( HDF5_DIFF_EXECUTABLE ) + +# Invoke the HDF5 wrapper compiler. The compiler return value is stored to the +# return_value argument, the text output is stored to the output variable. +macro( _HDF5_invoke_compiler language output return_value ) + if( HDF5_${language}_COMPILER_EXECUTABLE ) + exec_program( ${HDF5_${language}_COMPILER_EXECUTABLE} + ARGS -show + OUTPUT_VARIABLE ${output} + RETURN_VALUE ${return_value} + ) + if( ${${return_value}} EQUAL 0 ) + # do nothing + else() + message( STATUS + "Unable to determine HDF5 ${language} flags from HDF5 wrapper." ) + endif() + endif() +endmacro() + +# Parse a compile line for definitions, includes, library paths, and libraries. +macro( _HDF5_parse_compile_line + compile_line_var + include_paths + definitions + library_paths + libraries ) + + # Match the include paths + string( REGEX MATCHALL "-I([^\" ]+)" include_path_flags + "${${compile_line_var}}" + ) + foreach( IPATH ${include_path_flags} ) + string( REGEX REPLACE "^-I" "" IPATH ${IPATH} ) + string( REPLACE "//" "/" IPATH ${IPATH} ) + list( APPEND ${include_paths} ${IPATH} ) + endforeach() + + # Match the definitions + string( REGEX MATCHALL "-D[^ ]*" definition_flags "${${compile_line_var}}" ) + foreach( DEF ${definition_flags} ) + list( APPEND ${definitions} ${DEF} ) + endforeach() + + # Match the library paths + string( REGEX MATCHALL "-L([^\" ]+|\"[^\"]+\")" library_path_flags + "${${compile_line_var}}" + ) + + foreach( LPATH ${library_path_flags} ) + string( REGEX REPLACE "^-L" "" LPATH ${LPATH} ) + string( REPLACE "//" "/" LPATH ${LPATH} ) + list( APPEND ${library_paths} ${LPATH} ) + endforeach() + + # now search for the library names specified in the compile line (match -l...) + # match only -l's preceded by a space or comma + # this is to exclude directory names like xxx-linux/ + string( REGEX MATCHALL "[, ]-l([^\", ]+)" library_name_flags + "${${compile_line_var}}" ) + # strip the -l from all of the library flags and add to the search list + foreach( LIB ${library_name_flags} ) + string( REGEX REPLACE "^[, ]-l" "" LIB ${LIB} ) + list( APPEND ${libraries} ${LIB} ) + endforeach() +endmacro() + +# Try to find HDF5 using an installed hdf5-config.cmake +if( NOT HDF5_FOUND ) + find_package( HDF5 QUIET NO_MODULE ) + if( HDF5_FOUND ) + set( HDF5_INCLUDE_DIRS ${HDF5_INCLUDE_DIR} ) + set( HDF5_LIBRARIES ) + set( HDF5_C_TARGET hdf5 ) + set( HDF5_CXX_TARGET hdf5_cpp ) + set( HDF5_HL_TARGET hdf5_hl ) + set( HDF5_Fortran_TARGET hdf5_fortran ) + set( HDF5_Fortran_HL_TARGET hdf5_hl_fortran ) + foreach( _component ${HDF5_LANGUAGE_BINDINGS} ) + list( FIND HDF5_VALID_COMPONENTS ${_component} _component_location ) + get_target_property( _comp_location ${HDF5_${_component}_TARGET} LOCATION ) + if( _comp_location ) + set( HDF5_${_component}_LIBRARY ${_comp_location} CACHE PATH + "HDF5 ${_component} library" ) + mark_as_advanced( HDF5_${_component}_LIBRARY ) + list( APPEND HDF5_LIBRARIES ${HDF5_${_component}_LIBRARY} ) + endif() + endforeach() + endif() +endif() + +if( NOT HDF5_FOUND ) + _HDF5_invoke_compiler( C HDF5_C_COMPILE_LINE HDF5_C_RETURN_VALUE ) + _HDF5_invoke_compiler( CXX HDF5_CXX_COMPILE_LINE HDF5_CXX_RETURN_VALUE ) + _HDF5_invoke_compiler( Fortran HDF5_Fortran_COMPILE_LINE HDF5_Fortran_RETURN_VALUE ) + set(HDF5_HL_COMPILE_LINE ${HDF5_C_COMPILE_LINE}) + set(HDF5_Fortran_HL_COMPILE_LINE ${HDF5_Fortran_COMPILE_LINE}) + + # seed the initial lists of libraries to find with items we know we need + set( HDF5_C_LIBRARY_NAMES_INIT hdf5 ) + set( HDF5_HL_LIBRARY_NAMES_INIT hdf5_hl ${HDF5_C_LIBRARY_NAMES_INIT} ) + set( HDF5_CXX_LIBRARY_NAMES_INIT hdf5_cpp ${HDF5_C_LIBRARY_NAMES_INIT} ) + set( HDF5_Fortran_LIBRARY_NAMES_INIT hdf5_fortran + ${HDF5_C_LIBRARY_NAMES_INIT} ) + set( HDF5_Fortran_HL_LIBRARY_NAMES_INIT hdf5hl_fortran hdf5_hl + ${HDF5_Fortran_LIBRARY_NAMES_INIT} ) + + foreach( LANGUAGE ${HDF5_LANGUAGE_BINDINGS} ) + if( HDF5_${LANGUAGE}_COMPILE_LINE ) + _HDF5_parse_compile_line( HDF5_${LANGUAGE}_COMPILE_LINE + HDF5_${LANGUAGE}_INCLUDE_FLAGS + HDF5_${LANGUAGE}_DEFINITIONS + HDF5_${LANGUAGE}_LIBRARY_DIRS + HDF5_${LANGUAGE}_LIBRARY_NAMES + ) + + # take a guess that the includes may be in the 'include' sibling + # directory of a library directory. + foreach( dir ${HDF5_${LANGUAGE}_LIBRARY_DIRS} ) + list( APPEND HDF5_${LANGUAGE}_INCLUDE_FLAGS ${dir}/../include ) + endforeach() + endif() + + # set the definitions for the language bindings. + list( APPEND HDF5_DEFINITIONS ${HDF5_${LANGUAGE}_DEFINITIONS} ) + + # find the HDF5 include directories + if(${LANGUAGE} MATCHES "Fortran") + set(HDF5_INCLUDE_FILENAME hdf5.mod) + else() + set(HDF5_INCLUDE_FILENAME hdf5.h) + endif() + + find_path( HDF5_${LANGUAGE}_INCLUDE_DIR ${HDF5_INCLUDE_FILENAME} + HINTS + ${HDF5_${LANGUAGE}_INCLUDE_FLAGS} + ENV + HDF5_ROOT + PATHS + $ENV{HOME}/.local/include + PATH_SUFFIXES + include + Include + ) + mark_as_advanced( HDF5_${LANGUAGE}_INCLUDE_DIR ) + list( APPEND HDF5_INCLUDE_DIRS ${HDF5_${LANGUAGE}_INCLUDE_DIR} ) + + set( HDF5_${LANGUAGE}_LIBRARY_NAMES + ${HDF5_${LANGUAGE}_LIBRARY_NAMES_INIT} + ${HDF5_${LANGUAGE}_LIBRARY_NAMES} ) + + # find the HDF5 libraries + foreach( LIB ${HDF5_${LANGUAGE}_LIBRARY_NAMES} ) + if( UNIX AND HDF5_USE_STATIC_LIBRARIES ) + # According to bug 1643 on the CMake bug tracker, this is the + # preferred method for searching for a static library. + # See http://www.cmake.org/Bug/view.php?id=1643. We search + # first for the full static library name, but fall back to a + # generic search on the name if the static search fails. + set( THIS_LIBRARY_SEARCH_DEBUG lib${LIB}d.a ${LIB}d ) + set( THIS_LIBRARY_SEARCH_RELEASE lib${LIB}.a ${LIB} ) + else() + set( THIS_LIBRARY_SEARCH_DEBUG ${LIB}d ) + set( THIS_LIBRARY_SEARCH_RELEASE ${LIB} ) + endif() + find_library( HDF5_${LIB}_LIBRARY_DEBUG + NAMES ${THIS_LIBRARY_SEARCH_DEBUG} + HINTS ${HDF5_${LANGUAGE}_LIBRARY_DIRS} + ENV HDF5_ROOT + PATH_SUFFIXES lib Lib ) + find_library( HDF5_${LIB}_LIBRARY_RELEASE + NAMES ${THIS_LIBRARY_SEARCH_RELEASE} + HINTS ${HDF5_${LANGUAGE}_LIBRARY_DIRS} + ENV HDF5_ROOT + PATH_SUFFIXES lib Lib ) + select_library_configurations( HDF5_${LIB} ) + list(APPEND HDF5_${LANGUAGE}_LIBRARIES ${HDF5_${LIB}_LIBRARY}) + endforeach() + list( APPEND HDF5_LIBRARY_DIRS ${HDF5_${LANGUAGE}_LIBRARY_DIRS} ) + + # Append the libraries for this language binding to the list of all + # required libraries. + list(APPEND HDF5_LIBRARIES ${HDF5_${LANGUAGE}_LIBRARIES}) + endforeach() + + # We may have picked up some duplicates in various lists during the above + # process for the language bindings (both the C and C++ bindings depend on + # libz for example). Remove the duplicates. It appears that the default + # CMake behavior is to remove duplicates from the end of a list. However, + # for link lines, this is incorrect since unresolved symbols are searched + # for down the link line. Therefore, we reverse the list, remove the + # duplicates, and then reverse it again to get the duplicates removed from + # the beginning. + macro( _remove_duplicates_from_beginning _list_name ) + list( REVERSE ${_list_name} ) + list( REMOVE_DUPLICATES ${_list_name} ) + list( REVERSE ${_list_name} ) + endmacro() + + if( HDF5_INCLUDE_DIRS ) + _remove_duplicates_from_beginning( HDF5_INCLUDE_DIRS ) + endif() + if( HDF5_LIBRARY_DIRS ) + _remove_duplicates_from_beginning( HDF5_LIBRARY_DIRS ) + endif() + if( HDF5_LIBRARIES ) + _remove_duplicates_from_beginning( HDF5_LIBRARIES ) + endif() + + # If the HDF5 include directory was found, open H5pubconf.h to determine if + # HDF5 was compiled with parallel IO support + set( HDF5_IS_PARALLEL FALSE ) + set( HDF5_VERSION "" ) + foreach( _dir IN LISTS HDF5_INCLUDE_DIRS ) + foreach(_hdr "${_dir}/H5pubconf.h" "${_dir}/H5pubconf-64.h" "${_dir}/H5pubconf-32.h") + if( EXISTS "${_hdr}" ) + file( STRINGS "${_hdr}" + HDF5_HAVE_PARALLEL_DEFINE + REGEX "HAVE_PARALLEL 1" ) + if( HDF5_HAVE_PARALLEL_DEFINE ) + set( HDF5_IS_PARALLEL TRUE ) + endif() + unset(HDF5_HAVE_PARALLEL_DEFINE) + + file( STRINGS "${_hdr}" + HDF5_VERSION_DEFINE + REGEX "^[ \t]*#[ \t]*define[ \t]+H5_VERSION[ \t]+" ) + if( "${HDF5_VERSION_DEFINE}" MATCHES + "H5_VERSION[ \t]+\"([0-9]+\\.[0-9]+\\.[0-9]+).*\"" ) + set( HDF5_VERSION "${CMAKE_MATCH_1}" ) + endif() + unset(HDF5_VERSION_DEFINE) + endif() + endforeach() + endforeach() + set( HDF5_IS_PARALLEL ${HDF5_IS_PARALLEL} CACHE BOOL + "HDF5 library compiled with parallel IO support" ) + mark_as_advanced( HDF5_IS_PARALLEL ) + + # For backwards compatibility we set HDF5_INCLUDE_DIR to the value of + # HDF5_INCLUDE_DIRS + if( HDF5_INCLUDE_DIRS ) + set( HDF5_INCLUDE_DIR "${HDF5_INCLUDE_DIRS}" ) + endif() + +endif() + +find_package_handle_standard_args( HDF5 + REQUIRED_VARS HDF5_LIBRARIES HDF5_INCLUDE_DIRS + VERSION_VAR HDF5_VERSION +) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index e7ba39b64..28ac445ab 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -4,7 +4,7 @@ module hdf5_interface use h5lt use, intrinsic :: ISO_C_BINDING -#ifdef MPI +#ifdef PHDF5 use message_passing, only: MPI_COMM_WORLD, MPI_INFO_NULL #endif @@ -36,7 +36,7 @@ module hdf5_interface module procedure hdf5_write_integer_4Darray module procedure hdf5_write_long module procedure hdf5_write_string -#ifdef MPI +#ifdef PHDF5 module procedure hdf5_write_double_parallel module procedure hdf5_write_double_1Darray_parallel module procedure hdf5_write_double_2Darray_parallel @@ -66,7 +66,7 @@ module hdf5_interface module procedure hdf5_read_integer_4Darray module procedure hdf5_read_long module procedure hdf5_read_string -#ifdef MPI +#ifdef PHDF5 module procedure hdf5_read_double_parallel module procedure hdf5_read_double_1Darray_parallel module procedure hdf5_read_double_2Darray_parallel @@ -134,7 +134,7 @@ contains end subroutine hdf5_file_close -#ifdef MPI +#ifdef PHDF5 !=============================================================================== ! HDF5_FILE_CREATE_PARALLEL creates HDF5 file with parallel I/O @@ -809,7 +809,7 @@ contains end subroutine hdf5_write_attribute_string -# ifdef MPI +#ifdef PHDF5 !=============================================================================== ! HDF5_WRITE_INTEGER_PARALLEL writes integer scalar data in parallel @@ -1807,6 +1807,6 @@ contains end subroutine hdf5_read_string_parallel -# endif +#endif end module hdf5_interface diff --git a/src/output_interface.F90 b/src/output_interface.F90 index 7ced3c052..1e08ce491 100644 --- a/src/output_interface.F90 +++ b/src/output_interface.F90 @@ -96,7 +96,7 @@ contains self % serial = .true. end if -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_file_create(filename, self % hdf5_fh) else @@ -126,7 +126,7 @@ contains self % serial = .true. end if -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_file_open(filename, self % hdf5_fh, mode) else @@ -212,7 +212,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_write_double(self % hdf5_grp, name_, buffer) else @@ -263,7 +263,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_read_double(self % hdf5_grp, name_, buffer) else @@ -315,7 +315,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_write_double_1Darray(self % hdf5_grp, name_, buffer, length) else @@ -368,7 +368,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_read_double_1Darray(self % hdf5_grp, name_, buffer, length) else @@ -421,7 +421,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_write_double_2Darray(self % hdf5_grp, name_, buffer, length) else @@ -474,7 +474,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_read_double_2Darray(self % hdf5_grp, name_, buffer, length) else @@ -527,7 +527,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_write_double_3Darray(self % hdf5_grp, name_, buffer, length) else @@ -580,7 +580,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_read_double_3Darray(self % hdf5_grp, name_, buffer, length) else @@ -634,7 +634,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_write_double_4Darray(self % hdf5_grp, name_, buffer, length) else @@ -689,7 +689,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_read_double_4Darray(self % hdf5_grp, name_, buffer, length) else @@ -741,7 +741,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_write_integer(self % hdf5_grp, name_, buffer) else @@ -792,7 +792,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_read_integer(self % hdf5_grp, name_, buffer) else @@ -844,7 +844,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_write_integer_1Darray(self % hdf5_grp, name_, buffer, length) else @@ -897,7 +897,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_read_integer_1Darray(self % hdf5_grp, name_, buffer, length) else @@ -951,7 +951,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_write_integer_2Darray(self % hdf5_grp, name_, buffer, length) else @@ -1004,7 +1004,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_read_integer_2Darray(self % hdf5_grp, name_, buffer, length) else @@ -1057,7 +1057,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_write_integer_3Darray(self % hdf5_grp, name_, buffer, length) else @@ -1110,7 +1110,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_read_integer_3Darray(self % hdf5_grp, name_, buffer, length) else @@ -1164,7 +1164,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_write_integer_4Darray(self % hdf5_grp, name_, buffer, length) else @@ -1218,7 +1218,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_read_integer_4Darray(self % hdf5_grp, name_, buffer, length) else @@ -1270,7 +1270,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_write_long(self % hdf5_grp, name_, buffer, hdf5_integer8_t) else @@ -1322,7 +1322,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_read_long(self % hdf5_grp, name_, buffer, hdf5_integer8_t) else @@ -1378,7 +1378,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_write_string(self % hdf5_grp, name_, buffer, n) else @@ -1434,7 +1434,7 @@ contains else self % hdf5_grp = self % hdf5_fh endif -#ifdef MPI +#ifdef PHDF5 if (self % serial) then call hdf5_read_string(self % hdf5_grp, name_, buffer, n) else @@ -1579,11 +1579,11 @@ contains class(BinaryOutput) :: self -#ifdef MPI +#ifdef PHDF5 integer(8) :: offset(1) ! source data offset #endif -#ifdef MPI +#ifdef PHDF5 ! Set size of total dataspace for all procs and rank dims1(1) = n_particles @@ -1662,11 +1662,11 @@ contains class(BinaryOutput) :: self -#ifdef MPI +#ifdef PHDF5 integer(8) :: offset(1) ! offset of data #endif -#ifdef MPI +#ifdef PHDF5 ! Set size of total dataspace for all procs and rank dims1(1) = n_particles diff --git a/tests/run_tests.py b/tests/run_tests.py index aa2eb14cf..d3b79aa3b 100755 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -107,12 +107,13 @@ tests = OrderedDict() class Test(object): def __init__(self, name, debug=False, optimize=False, mpi=False, openmp=False, - valgrind=False, coverage=False): + phdf5=False, valgrind=False, coverage=False): self.name = name self.debug = debug self.optimize = optimize self.mpi = mpi self.openmp = openmp + self.phdf5 = phdf5 self.valgrind = valgrind self.coverage = coverage self.success = True @@ -125,9 +126,9 @@ class Test(object): # Check for MPI if self.mpi: - self.fc = PHDF5_DIR + '/bin/h5pfc' + self.fc = os.path.join(MPI_DIR, 'bin', 'mpifort') else: - self.fc = HDF5_DIR + '/bin/h5fc' + self.fc = FC # Sets the build name that will show up on the CDash def get_build_name(self): @@ -159,6 +160,10 @@ class Test(object): os.environ['FC'] = self.fc if self.mpi: os.environ['MPI_DIR'] = MPI_DIR + if self.phdf5: + os.environ['HDF5_ROOT'] = PHDF5_DIR + else: + os.environ['HDF5_ROOT'] = HDF5_DIR rc = call(['ctest', '-S', 'ctestscript.run','-V']) if rc != 0: self.success = False @@ -169,6 +174,10 @@ class Test(object): os.environ['FC'] = self.fc if self.mpi: os.environ['MPI_DIR'] = MPI_DIR + if self.phdf5: + os.environ['HDF5_ROOT'] = PHDF5_DIR + else: + os.environ['HDF5_ROOT'] = HDF5_DIR build_opts = self.build_opts.split() self.cmake += build_opts rc = call(self.cmake) @@ -258,8 +267,8 @@ class Test(object): # Simple function to add a test to the global tests dictionary def add_test(name, debug=False, optimize=False, mpi=False, openmp=False,\ - valgrind=False, coverage=False): - tests.update({name: Test(name, debug, optimize, mpi, openmp, + phdf5=False, valgrind=False, coverage=False): + tests.update({name: Test(name, debug, optimize, mpi, openmp, phdf5, valgrind, coverage)}) # List of all tests that may be run. User can add -C to command line to specify @@ -270,12 +279,15 @@ add_test('hdf5-optimize', optimize=True) add_test('omp-hdf5-normal', openmp=True) add_test('omp-hdf5-debug', openmp=True, debug=True) add_test('omp-hdf5-optimize', openmp=True, optimize=True) -add_test('phdf5-normal', mpi=True) -add_test('phdf5-debug', mpi=True, debug=True) -add_test('phdf5-optimize', mpi=True, optimize=True) -add_test('phdf5-omp-normal', mpi=True, openmp=True) -add_test('phdf5-omp-debug', mpi=True, openmp=True, debug=True) -add_test('phdf5-omp-optimize', mpi=True, openmp=True, optimize=True) +add_test('mpi-hdf5-normal', mpi=True) +add_test('mpi-hdf5-debug', mpi=True, debug=True) +add_test('mpi-hdf5-optimize', mpi=True, optimize=True) +add_test('phdf5-normal', mpi=True, phdf5=True) +add_test('phdf5-debug', mpi=True, phdf5=True, debug=True) +add_test('phdf5-optimize', mpi=True, phdf5=True, optimize=True) +add_test('phdf5-omp-normal', mpi=True, phdf5=True, openmp=True) +add_test('phdf5-omp-debug', mpi=True, phdf5=True, openmp=True, debug=True) +add_test('phdf5-omp-optimize', mpi=True, phdf5=True, openmp=True, optimize=True) add_test('hdf5-debug_valgrind', debug=True, valgrind=True) add_test('hdf5-debug_coverage', debug=True, coverage=True) From 3fb6f99ecdca38fb4050179f3f10b03ed26fac35 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Tue, 1 Sep 2015 09:54:49 +0700 Subject: [PATCH 07/32] Update FindHDF5 based on Brad King comments --- cmake/Modules/FindHDF5.cmake | 74 ++++++++++++++---------------------- 1 file changed, 29 insertions(+), 45 deletions(-) diff --git a/cmake/Modules/FindHDF5.cmake b/cmake/Modules/FindHDF5.cmake index 1631f0193..08ba0abaf 100644 --- a/cmake/Modules/FindHDF5.cmake +++ b/cmake/Modules/FindHDF5.cmake @@ -103,52 +103,39 @@ else() endforeach() endif() +# Determine whether to search for serial or parallel executable first if(HDF5_PREFER_PARALLEL) - # try to find the HDF5 wrapper compilers - find_program( HDF5_C_COMPILER_EXECUTABLE - NAMES h5pcc h5cc - HINTS ENV HDF5_ROOT - PATH_SUFFIXES bin Bin - DOC "HDF5 Wrapper compiler. Used only to detect HDF5 compile flags." ) - mark_as_advanced( HDF5_C_COMPILER_EXECUTABLE ) - - find_program( HDF5_CXX_COMPILER_EXECUTABLE - NAMES h5pc++ h5c++ - HINTS ENV HDF5_ROOT - PATH_SUFFIXES bin Bin - DOC "HDF5 C++ Wrapper compiler. Used only to detect HDF5 compile flags." ) - mark_as_advanced( HDF5_CXX_COMPILER_EXECUTABLE ) - - find_program( HDF5_Fortran_COMPILER_EXECUTABLE - NAMES h5pfc h5fc - HINTS ENV HDF5_ROOT - PATH_SUFFIXES bin Bin - DOC "HDF5 Fortran Wrapper compiler. Used only to detect HDF5 compile flags." ) - mark_as_advanced( HDF5_Fortran_COMPILER_EXECUTABLE ) + set(HDF5_C_COMPILER_NAMES h5pcc h5cc) + set(HDF5_CXX_COMPILER_NAMES h5pc++ h5c++) + set(HDF5_Fortran_COMPILER_NAMES h5pfc h5fc) else() - # try to find the HDF5 wrapper compilers - find_program( HDF5_C_COMPILER_EXECUTABLE - NAMES h5cc h5pcc - HINTS ENV HDF5_ROOT - PATH_SUFFIXES bin Bin - DOC "HDF5 Wrapper compiler. Used only to detect HDF5 compile flags." ) - mark_as_advanced( HDF5_C_COMPILER_EXECUTABLE ) - - find_program( HDF5_CXX_COMPILER_EXECUTABLE - NAMES h5c++ h5pc++ - HINTS ENV HDF5_ROOT - PATH_SUFFIXES bin Bin - DOC "HDF5 C++ Wrapper compiler. Used only to detect HDF5 compile flags." ) - mark_as_advanced( HDF5_CXX_COMPILER_EXECUTABLE ) - - find_program( HDF5_Fortran_COMPILER_EXECUTABLE - NAMES h5fc h5pfc - HINTS ENV HDF5_ROOT - PATH_SUFFIXES bin Bin - DOC "HDF5 Fortran Wrapper compiler. Used only to detect HDF5 compile flags." ) - mark_as_advanced( HDF5_Fortran_COMPILER_EXECUTABLE ) + set(HDF5_C_COMPILER_NAMES h5cc h5pcc) + set(HDF5_CXX_COMPILER_NAMES h5c++ h5pc++) + set(HDF5_Fortran_COMPILER_NAMES h5fc h5pfc) endif() +# try to find the HDF5 wrapper compilers +find_program( HDF5_C_COMPILER_EXECUTABLE + NAMES ${HDF5_C_COMPILER_NAMES} + HINTS ENV HDF5_ROOT + PATH_SUFFIXES bin Bin + DOC "HDF5 Wrapper compiler. Used only to detect HDF5 compile flags." ) +mark_as_advanced( HDF5_C_COMPILER_EXECUTABLE ) + +find_program( HDF5_CXX_COMPILER_EXECUTABLE + NAMES ${HDF5_CXX_COMPILER_NAMES} + HINTS ENV HDF5_ROOT + PATH_SUFFIXES bin Bin + DOC "HDF5 C++ Wrapper compiler. Used only to detect HDF5 compile flags." ) +mark_as_advanced( HDF5_CXX_COMPILER_EXECUTABLE ) + +find_program( HDF5_Fortran_COMPILER_EXECUTABLE + NAMES ${HDF5_Fortran_COMPILER_NAMES} + HINTS ENV HDF5_ROOT + PATH_SUFFIXES bin Bin + DOC "HDF5 Fortran Wrapper compiler. Used only to detect HDF5 compile flags." ) +mark_as_advanced( HDF5_Fortran_COMPILER_EXECUTABLE ) + find_program( HDF5_DIFF_EXECUTABLE NAMES h5diff HINTS ENV HDF5_ROOT @@ -359,9 +346,6 @@ if( NOT HDF5_FOUND ) if( HDF5_LIBRARY_DIRS ) _remove_duplicates_from_beginning( HDF5_LIBRARY_DIRS ) endif() - if( HDF5_LIBRARIES ) - _remove_duplicates_from_beginning( HDF5_LIBRARIES ) - endif() # If the HDF5 include directory was found, open H5pubconf.h to determine if # HDF5 was compiled with parallel IO support From 779a401448b5d014535f6924861b04f5162ed62a Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Tue, 1 Sep 2015 16:47:08 +0700 Subject: [PATCH 08/32] Have write_integer, write_double, and write_long use scalar values --- openmc/particle_restart.py | 39 +++----- openmc/statepoint.py | 182 +++++++++++++----------------------- scripts/openmc-track-to-vtk | 2 +- src/hdf5_interface.F90 | 85 ++++++----------- 4 files changed, 108 insertions(+), 200 deletions(-) diff --git a/openmc/particle_restart.py b/openmc/particle_restart.py index 5ae534dbd..846c7d566 100644 --- a/openmc/particle_restart.py +++ b/openmc/particle_restart.py @@ -48,38 +48,23 @@ class Particle(object): def _read_data(self): # Read filetype - self.filetype = self._get_int(path='filetype')[0] + self.filetype = self._f['filetype'].value # Read statepoint revision - self.revision = self._get_int(path='revision')[0] + self.revision = self._f['revision'].value # Read current batch - self.current_batch = self._get_int(path='current_batch')[0] + self.current_batch = self._f['current_batch'].value # Read run information - self.gen_per_batch = self._get_int(path='gen_per_batch')[0] - self.current_gen = self._get_int(path='current_gen')[0] - self.n_particles = self._get_long(path='n_particles')[0] - self.run_mode = self._get_int(path='run_mode')[0] + self.gen_per_batch = self._f['gen_per_batch'].value + self.current_gen = self._f['current_gen'].value + self.n_particles = self._f['n_particles'].value + self.run_mode = self._f['run_mode'].value # Read particle properties - self.id = self._get_long(path='id')[0] - self.weight = self._get_double(path='weight')[0] - self.energy = self._get_double(path='energy')[0] - self.xyz = self._get_double(3, path='xyz') - self.uvw = self._get_double(3, path='uvw') - - def _get_int(self, n=1, path=None): - return [int(v) for v in self._f[path].value] - - def _get_long(self, n=1, path=None): - return [int(v) for v in self._f[path].value] - - def _get_float(self, n=1, path=None): - return [float(v) for v in self._f[path].value] - - def _get_double(self, n=1, path=None): - return [float(v) for v in self._f[path].value] - - def _get_string(self, n=1, path=None): - return str(self._f[path].value) + self.id = self._f['id'].value + self.weight = self._f['weight'].value + self.energy = self._f['energy'].value + self.xyz = self._f['xyz'].value + self.uvw = self._f['uvw'].value diff --git a/openmc/statepoint.py b/openmc/statepoint.py index 673b41e17..af423b027 100644 --- a/openmc/statepoint.py +++ b/openmc/statepoint.py @@ -1,5 +1,4 @@ import copy -import struct import sys import numpy as np @@ -158,37 +157,37 @@ class StatePoint(object): def _read_metadata(self): # Read filetype - self._filetype = self._get_int(path='filetype')[0] + self._filetype = self._f['filetype'].value # Read statepoint revision - self._revision = self._get_int(path='revision')[0] + self._revision = self._f['revision'].value if self._revision != 13: raise Exception('Statepoint Revision is not consistent.') # Read OpenMC version - self._version = [self._get_int(path='version_major')[0], - self._get_int(path='version_minor')[0], - self._get_int(path='version_release')[0]] + self._version = [self._f['version_major'].value, + self._f['version_minor'].value, + self._f['version_release'].value] # Read date and time - self._date_and_time = self._get_string(19, path='date_and_time') + self._date_and_time = self._f['date_and_time'].value[0] # Read path - self._path = self._get_string(255, path='path').strip() + self._path = self._f['path'].value[0].strip() # Read random number seed - self._seed = self._get_long(path='seed')[0] + self._seed = self._f['seed'].value # Read run information - self._run_mode = self._get_int(path='run_mode')[0] - self._n_particles = self._get_long(path='n_particles')[0] - self._n_batches = self._get_int(path='n_batches')[0] + self._run_mode = self._f['run_mode'].value + self._n_particles = self._f['n_particles'].value + self._n_batches = self._f['n_batches'].value # Read current batch - self._current_batch = self._get_int(path='current_batch')[0] + self._current_batch = self._f['current_batch'].value # Read whether or not the source site distribution is present - self._source_present = self._get_int(path='source_present')[0] + self._source_present = self._f['source_present'].value # Read criticality information if self._run_mode == 2: @@ -198,18 +197,15 @@ class StatePoint(object): # Read criticality information 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*self._gen_per_batch, - path='k_generation') - self._entropy = self._get_double( - self._current_batch*self._gen_per_batch, path='entropy') + self._n_inactive = self._f['n_inactive'].value + self._gen_per_batch = self._f['gen_per_batch'].value + self._k_batch = self._f['k_generation'].value + self._entropy = self._f['entropy'].value - self._k_col_abs = self._get_double(path='k_col_abs')[0] - self._k_col_tra = self._get_double(path='k_col_tra')[0] - self._k_abs_tra = self._get_double(path='k_abs_tra')[0] - self._k_combined = self._get_double(2, path='k_combined') + self._k_col_abs = self._f['k_col_abs'].value + self._k_col_tra = self._f['k_col_tra'].value + self._k_abs_tra = self._f['k_abs_tra'].value + self._k_combined = self._f['k_combined'].value # Read CMFD information (if used) self._read_cmfd() @@ -218,25 +214,18 @@ class StatePoint(object): base = 'cmfd' # Read CMFD information - self._cmfd_on = self._get_int(path='cmfd_on')[0] + self._cmfd_on = self._f['cmfd_on'].value if self._cmfd_on == 1: - - self._cmfd_indices = self._get_int(4, path='{0}/indices'.format(base)) - self._k_cmfd = self._get_double(self._current_batch, - path='{0}/k_cmfd'.format(base)) - self._cmfd_src = self._get_double_array(np.product(self._cmfd_indices), - path='{0}/cmfd_src'.format(base)) + self._cmfd_indices = self._f['{0}/indices'.format(base)].value + self._k_cmfd = self._f['{0}/k_cmfd'.format(base)].value + self._cmfd_src = self._f['{0}/cmfd_src'.format(base)].value self._cmfd_src = np.reshape(self._cmfd_src, tuple(self._cmfd_indices), order='F') - self._cmfd_entropy = self._get_double(self._current_batch, - path='{0}/cmfd_entropy'.format(base)) - self._cmfd_balance = self._get_double(self._current_batch, - path='{0}/cmfd_balance'.format(base)) - self._cmfd_dominance = self._get_double(self._current_batch, - path='{0}/cmfd_dominance'.format(base)) - self._cmfd_srccmp = self._get_double(self._current_batch, - path='{0}/cmfd_srccmp'.format(base)) + self._cmfd_entropy = self._f['{0}/cmfd_entropy'.format(base)].value + self._cmfd_balance = self._f['{0}/cmfd_balance'.format(base)].value + self._cmfd_dominance = self._f['{0}/cmfd_dominance'.format(base)].value + self._cmfd_srccmp = self._f['{0}/cmfd_srccmp'.format(base)].value def _read_meshes(self): # Initialize dictionaries for the Meshes @@ -245,18 +234,16 @@ class StatePoint(object): self._meshes = {} # Read the number of Meshes - self._n_meshes = self._get_int(path='tallies/meshes/n_meshes')[0] + self._n_meshes = self._f['tallies/meshes/n_meshes'].value # Read a list of the IDs for each Mesh if self._n_meshes > 0: # OpenMC Mesh IDs (redefined internally from user definitions) - self._mesh_ids = self._get_int(self._n_meshes, - path='tallies/meshes/ids') + self._mesh_ids = self._f['tallies/meshes/ids'].value # User-defined Mesh IDs - self._mesh_keys = self._get_int(self._n_meshes, - path='tallies/meshes/keys') + self._mesh_keys = self._f['tallies/meshes/keys'].value else: self._mesh_keys = [] @@ -269,23 +256,18 @@ class StatePoint(object): for mesh_key in self._mesh_keys: # Read the user-specified Mesh ID and type - mesh_id = self._get_int(path='{0}{1}/id'.format(base, mesh_key))[0] - mesh_type = self._get_int(path='{0}{1}/type'.format(base, mesh_key))[0] + mesh_id = self._f['{0}{1}/id'.format(base, mesh_key)].value + mesh_type = self._f['{0}{1}/type'.format(base, mesh_key)].value # Get the Mesh dimension - n_dimension = self._get_int( - path='{0}{1}/n_dimension'.format(base, mesh_key))[0] + n_dimension = self._f['{0}{1}/n_dimension'.format(base, mesh_key)].value # Read the mesh dimensions, lower-left coordinates, # upper-right coordinates, and width of each mesh cell - dimension = self._get_int( - n_dimension, path='{0}{1}/dimension'.format(base, mesh_key)) - lower_left = self._get_double( - n_dimension, path='{0}{1}/lower_left'.format(base, mesh_key)) - upper_right = self._get_double( - n_dimension, path='{0}{1}/upper_right'.format(base, mesh_key)) - width = self._get_double( - n_dimension, path='{0}{1}/width'.format(base, mesh_key)) + dimension = self._f['{0}{1}/dimension'.format(base, mesh_key)].value + lower_left = self._f['{0}{1}/lower_left'.format(base, mesh_key)].value + upper_right = self._f['{0}{1}/upper_right'.format(base, mesh_key)].value + width = self._f['{0}{1}/width'.format(base, mesh_key)].value # Create the Mesh and assign properties to it mesh = openmc.Mesh(mesh_id) @@ -308,18 +290,16 @@ class StatePoint(object): self._tallies = {} # Read the number of tallies - self._n_tallies = self._get_int(path='/tallies/n_tallies')[0] + self._n_tallies = self._f['/tallies/n_tallies'].value # Read a list of the IDs for each Tally if self._n_tallies > 0: # OpenMC Tally IDs (redefined internally from user definitions) - self._tally_ids = self._get_int( - self._n_tallies, path='tallies/ids') + self._tally_ids = self._f['tallies/ids'].value # User-defined Tally IDs - self._tally_keys = self._get_int( - self._n_tallies, path='tallies/keys') + self._tally_keys = self._f['tallies/keys'].value else: self._tally_keys = [] @@ -331,12 +311,10 @@ class StatePoint(object): for tally_key in self._tally_keys: # Read integer Tally estimator type code (analog or tracklength) - estimator_type = self._get_int( - path='{0}{1}/estimator'.format(base, tally_key))[0] + estimator_type = self._f['{0}{1}/estimator'.format(base, tally_key)].value # Read the Tally size specifications - n_realizations = self._get_int( - path='{0}{1}/n_realizations'.format(base, tally_key))[0] + n_realizations = self._f['{0}{1}/n_realizations'.format(base, tally_key)].value # Create Tally object and assign basic properties tally = openmc.Tally(tally_key) @@ -344,8 +322,7 @@ class StatePoint(object): tally.num_realizations = n_realizations # Read the number of Filters - n_filters = self._get_int( - path='{0}{1}/n_filters'.format(base, tally_key))[0] + n_filters = self._f['{0}{1}/n_filters'.format(base, tally_key)].value subbase = '{0}{1}/filter '.format(base, tally_key) @@ -353,15 +330,12 @@ class StatePoint(object): for j in range(1, n_filters+1): # Read the integer Filter type code - filter_type = self._get_int( - path='{0}{1}/type'.format(subbase, j))[0] + filter_type = self._f['{0}{1}/type'.format(subbase, j)].value # Read the Filter offset - offset = self._get_int( - path='{0}{1}/offset'.format(subbase, j))[0] + offset = self._f['{0}{1}/offset'.format(subbase, j)].value - n_bins = self._get_int( - path='{0}{1}/n_bins'.format(subbase, j))[0] + n_bins = self._f['{0}{1}/n_bins'.format(subbase, j)].value if n_bins <= 0: msg = 'Unable to create Filter "{0}" for Tally ID="{1}" ' \ @@ -370,16 +344,13 @@ class StatePoint(object): # Read the bin values if FILTER_TYPES[filter_type] in ['energy', 'energyout']: - bins = self._get_double( - n_bins+1, path='{0}{1}/bins'.format(subbase, j)) + bins = self._f['{0}{1}/bins'.format(subbase, j)].value elif FILTER_TYPES[filter_type] in ['mesh', 'distribcell']: - bins = self._get_int( - path='{0}{1}/bins'.format(subbase, j))[0] + bins = self._f['{0}{1}/bins'.format(subbase, j)].value else: - bins = self._get_int( - n_bins, path='{0}{1}/bins'.format(subbase, j)) + bins = self._f['{0}{1}/bins'.format(subbase, j)].value # Create Filter object filter = openmc.Filter(FILTER_TYPES[filter_type], bins) @@ -387,33 +358,30 @@ class StatePoint(object): filter.num_bins = n_bins if FILTER_TYPES[filter_type] == 'mesh': - key = self._mesh_keys[self._mesh_ids.index(bins)] + key = self._mesh_keys[list(self._mesh_ids).index(bins)] filter.mesh = self._meshes[key] # Add Filter to the Tally tally.add_filter(filter) # Read Nuclide bins - n_nuclides = self._get_int( - path='{0}{1}/n_nuclides'.format(base, tally_key))[0] + n_nuclides = self._f['{0}{1}/n_nuclides'.format(base, tally_key)].value - nuclide_zaids = self._get_int( - n_nuclides, path='{0}{1}/nuclides'.format(base, tally_key)) + nuclide_zaids = self._f['{0}{1}/nuclides'.format(base, tally_key)].value # Add all Nuclides to the Tally for nuclide_zaid in nuclide_zaids: tally.add_nuclide(nuclide_zaid) # Read score bins - n_score_bins = self._get_int( - path='{0}{1}/n_score_bins'.format(base, tally_key))[0] + n_score_bins = self._f['{0}{1}/n_score_bins'.format(base, tally_key)].value tally.num_score_bins = n_score_bins - scores = [SCORE_TYPES[j] for j in self._get_int( - n_score_bins, path='{0}{1}/score_bins'.format(base, tally_key))] - n_user_scores = self._get_int( - path='{0}{1}/n_user_score_bins'.format(base, tally_key))[0] + scores = [SCORE_TYPES[j] for j in self._f[ + '{0}{1}/score_bins'.format(base, tally_key)].value] + n_user_scores = self._f['{0}{1}/n_user_score_bins' + .format(base, tally_key)].value # Compute and set the filter strides for i in range(n_filters): @@ -429,8 +397,8 @@ class StatePoint(object): # Extract the moment order string for each score for k in range(len(scores)): - moment = self._get_string(8, - path='{0}order{1}'.format(subbase, k+1)) + moment = str(self._f['{0}order{1}'.format( + subbase, k+1)].value[0]) moment = moment.lstrip('[\'') moment = moment.rstrip('\']') @@ -460,16 +428,16 @@ class StatePoint(object): """ # Number of realizations for global Tallies - self._n_realizations = self._get_int(path='n_realizations')[0] + self._n_realizations = self._f['n_realizations'].value # Read global Tallies - n_global_tallies = self._get_int(path='n_global_tallies')[0] + n_global_tallies = self._f['n_global_tallies'].value data = self._f['global_tallies'].value self._global_tallies = np.column_stack((data['sum'], data['sum_sq'])) # Flag indicating if Tallies are present - self._tallies_present = self._get_int(path='tallies/tallies_present')[0] + self._tallies_present = self._f['tallies/tallies_present'].value base = 'tallies/tally ' @@ -766,25 +734,3 @@ class StatePoint(object): filter.bins = material_ids self._with_summary = True - - def _get_data(self, n, typeCode, size): - return list(struct.unpack('={0}{1}'.format(n, typeCode), - self._f.read(n*size))) - - def _get_int(self, n=1, path=None): - return [int(v) for v in self._f[path].value] - - def _get_long(self, n=1, path=None): - return [long(v) for v in self._f[path].value] - - def _get_float(self, n=1, path=None): - return [float(v) for v in self._f[path].value] - - def _get_double(self, n=1, path=None): - return [float(v) for v in self._f[path].value] - - def _get_double_array(self, n=1, path=None): - return self._f[path].value - - def _get_string(self, n=1, path=None): - return str(self._f[path].value) diff --git a/scripts/openmc-track-to-vtk b/scripts/openmc-track-to-vtk index f44b3871a..434cd3bb0 100755 --- a/scripts/openmc-track-to-vtk +++ b/scripts/openmc-track-to-vtk @@ -82,7 +82,7 @@ def main(): else: track = h5py.File(fname) - n_particles = track['n_particles'].value[0] + n_particles = track['n_particles'].value n_coords = track['n_coords'] coords = [] for i in range(n_particles): diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 28ac445ab..b22d0414f 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -246,14 +246,17 @@ contains integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - integer, intent(in) :: buffer ! data to write + integer, target, intent(in) :: buffer ! data to write - ! Set rank and dimensions - hdf5_rank = 1 - dims1(1) = 1 + ! Create space, dataset, and write + call h5screate_f(H5S_SCALAR_F, dspace, hdf5_err) + call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) - call h5ltmake_dataset_int_f(group, name, hdf5_rank, dims1, & - (/ buffer /), hdf5_err) + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) end subroutine hdf5_write_integer @@ -265,16 +268,12 @@ contains 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, target, intent(inout) :: buffer ! read data to here - integer :: buffer_copy(1) ! need an array for read - - ! Set up dimensions - dims1(1) = 1 - - ! Read data - call h5ltread_dataset_int_f(group, name, buffer_copy, dims1, hdf5_err) - buffer = buffer_copy(1) + call h5dopen_f(group, name, dset, hdf5_err) + f_ptr = c_loc(buffer) + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + call h5dclose_f(dset, hdf5_err) end subroutine hdf5_read_integer @@ -450,14 +449,17 @@ contains integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer ! data to write + real(8), target, intent(in) :: buffer ! data to write - ! Set rank and dimensions - hdf5_rank = 1 - dims1(1) = 1 + ! Create space, dataset, and write + call h5screate_f(H5S_SCALAR_F, dspace, hdf5_err) + call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & - (/ buffer /), hdf5_err) + ! Close all + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) end subroutine hdf5_write_double @@ -469,16 +471,12 @@ contains integer(HID_T), intent(in) :: group ! name of group character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer ! read data to here + real(8), target, intent(inout) :: buffer ! read data to here - real(8) :: buffer_copy(1) ! need an array for read - - ! Set up dimensions - dims1(1) = 1 - - ! Read data - call h5ltread_dataset_double_f(group, name, buffer_copy, dims1, hdf5_err) - buffer = buffer_copy(1) + call h5dopen_f(group, name, dset, hdf5_err) + f_ptr = c_loc(buffer) + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + call h5dclose_f(dset, hdf5_err) end subroutine hdf5_read_double @@ -657,15 +655,9 @@ contains integer(8), target, intent(in) :: buffer ! data to write integer(HID_T), intent(in) :: long_type ! HDF5 long type - ! Set up rank and dimensions - hdf5_rank = 1 - dims1(1) = 1 - ! Create dataspace and dataset - call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) + call h5screate_f(H5S_SCALAR_F, dspace, hdf5_err) call h5dcreate_f(group, name, long_type, dspace, dset, hdf5_err) - - ! Write eight-byte integer f_ptr = c_loc(buffer) call h5dwrite_f(dset, long_type, f_ptr, hdf5_err) @@ -686,16 +678,9 @@ contains integer(8), target, intent(out) :: buffer ! read data to here integer(HID_T), intent(in) :: long_type ! long integer type - ! Open dataset call h5dopen_f(group, name, dset, hdf5_err) - - ! Get pointer to buffer f_ptr = c_loc(buffer) - - ! Read data from dataset call h5dread_f(dset, long_type, f_ptr, hdf5_err) - - ! Close dataset call h5dclose_f(dset, hdf5_err) end subroutine hdf5_read_long @@ -822,10 +807,6 @@ contains integer,target, intent(in) :: buffer ! data to write logical, intent(in) :: collect ! collect I/O - ! Set rank and dimensions - hdf5_rank = 1 - dims1(1) = 1 - ! Create property list for independent or collective read call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) @@ -837,7 +818,7 @@ contains end if ! Create dataspace - call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) + call h5screate_f(H5S_SCALAR_F, dspace, hdf5_err) ! Create dataset call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) @@ -1222,10 +1203,6 @@ contains real(8),target, intent(in) :: buffer ! data to write logical, intent(in) :: collect ! collect I/O - ! Set rank and dimensions - hdf5_rank = 1 - dims1(1) = 1 - ! Create property list for independent or collective read call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) @@ -1237,7 +1214,7 @@ contains end if ! Create dataspace - call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) + call h5screate_f(H5S_SCALAR_F, dspace, hdf5_err) ! Create dataset call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) From dce020b59e59da41b34ebc901631455a66f4207e Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Tue, 1 Sep 2015 16:51:11 +0700 Subject: [PATCH 09/32] Remove logic for binary file in openmc-track-to-vtk --- scripts/openmc-track-to-vtk | 46 +++++++++---------------------------- 1 file changed, 11 insertions(+), 35 deletions(-) diff --git a/scripts/openmc-track-to-vtk b/scripts/openmc-track-to-vtk index 434cd3bb0..c900c4aa5 100755 --- a/scripts/openmc-track-to-vtk +++ b/scripts/openmc-track-to-vtk @@ -18,6 +18,7 @@ Usage information can be obtained by running 'track.py --help': import os import argparse +import h5py import struct import vtk @@ -41,9 +42,8 @@ def main(): # Check input file extensions. for fname in args.input: - if not (fname.endswith('.h5') or fname.endswith('.binary')): - raise ValueError("Input file names must either end with '.h5' or" - "'.binary'.") + if not fname.endswith('.h5'): + raise ValueError("Input file names must an HDF5 file.") # Make sure that the output filename ends with '.pvtp'. if not args.out: @@ -51,44 +51,20 @@ def main(): elif not args.out.endswith('.pvtp'): args.out += '.pvtp' - # Import HDF library if HDF files are present - for fname in args.input: - if fname.endswith('.h5'): - import h5py - break - # Initialize data arrays and offset. points = vtk.vtkPoints() cells = vtk.vtkCellArray() point_offset = 0 for fname in args.input: # Write coordinate values to points array. - if fname.endswith('.binary'): - track = open(fname, 'rb') - - # Determine number of particles and tracks/particle - n_particles = struct.unpack('i', track.read(4))[0] - n_coords = struct.unpack('i'*n_particles, track.read(4*n_particles)) - - coords = [] - for i in range(n_particles): - # Read coordinates for each particle - coords.append([struct.unpack('ddd', track.read(24)) - for j in range(n_coords[i])]) - - # Add coordinates to points data - for triplet in coords[i]: - points.InsertNextPoint(triplet) - - else: - track = h5py.File(fname) - n_particles = track['n_particles'].value - n_coords = track['n_coords'] - coords = [] - for i in range(n_particles): - coords.append(track['coordinates_' + str(i + 1)].value) - for j in range(n_coords[i]): - points.InsertNextPoint(coords[i][j,:]) + track = h5py.File(fname) + n_particles = track['n_particles'].value + n_coords = track['n_coords'] + coords = [] + for i in range(n_particles): + coords.append(track['coordinates_' + str(i + 1)].value) + for j in range(n_coords[i]): + points.InsertNextPoint(coords[i][j,:]) for i in range(n_particles): # Create VTK line and assign points to line. From 205be92897f435a88679c3b6c703cf078a8c0f74 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Wed, 2 Sep 2015 09:43:13 +0700 Subject: [PATCH 10/32] Complete rewrite of hdf5_interface with a flat API --- src/bank_header.F90 | 17 +- src/global.F90 | 9 - src/hdf5_interface.F90 | 3389 ++++++++++++++++++++-------------------- src/tally_header.F90 | 9 +- 4 files changed, 1743 insertions(+), 1681 deletions(-) diff --git a/src/bank_header.F90 b/src/bank_header.F90 index 1a91f86f7..499358120 100644 --- a/src/bank_header.F90 +++ b/src/bank_header.F90 @@ -1,5 +1,7 @@ module bank_header + use, intrinsic :: ISO_C_BINDING + implicit none !=============================================================================== @@ -8,16 +10,11 @@ module bank_header ! stored with less memory !=============================================================================== - type Bank - ! The 'sequence' attribute is used here to ensure that the data listed - ! appears in the given order. This is important for MPI purposes when bank - ! sites are sent from one processor to another. - sequence - - real(8) :: wgt ! weight of bank site - real(8) :: xyz(3) ! location of bank particle - real(8) :: uvw(3) ! diretional cosines - real(8) :: E ! energy + type, bind(C) :: Bank + real(C_DOUBLE) :: wgt ! weight of bank site + real(C_DOUBLE) :: xyz(3) ! location of bank particle + real(C_DOUBLE) :: uvw(3) ! diretional cosines + real(C_DOUBLE) :: E ! energy end type Bank end module bank_header diff --git a/src/global.F90 b/src/global.F90 index ae2f5bb27..0c5e38212 100644 --- a/src/global.F90 +++ b/src/global.F90 @@ -16,7 +16,6 @@ module global use trigger_header, only: KTrigger use timer_header, only: Timer - use hdf5_interface, only: HID_T #ifdef MPIF08 use mpi_f08 #endif @@ -265,14 +264,6 @@ module global real(8) :: weight_cutoff = 0.25_8 real(8) :: weight_survive = ONE - ! ============================================================================ - ! HDF5 VARIABLES - - integer(HID_T) :: hdf5_output_file ! identifier for output file - 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) - ! ============================================================================ ! MISCELLANEOUS VARIABLES diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index b22d0414f..041e948ff 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -1,5 +1,15 @@ module hdf5_interface + ! This module provides the high-level procedures which greatly simplify + ! writing/reading different types of data to HDF5 files. In order to get it to + ! work with gfotran 4.6, all the write__ND subroutines had to be split + ! into two procedures, one accepting an assumed-shape array and another one + ! with an explicit-shape array since in gfortran 4.6 C_LOC does not work with + ! an assumed-shape array. When we move to gfortran 4.9+, these procedures can + ! be combined into one simply accepting an assumed-shape array. + + use tally_header, only: TallyResult + use hdf5 use h5lt use, intrinsic :: ISO_C_BINDING @@ -9,1781 +19,1844 @@ module hdf5_interface #endif implicit none + private - 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) :: 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 - integer(HSIZE_T) :: dims4(4) ! dims type for 4-D array - type(c_ptr) :: f_ptr ! pointer to data + integer(HID_T), public :: hdf5_tallyresult_t ! Compound type for TallyResult + integer(HID_T), public :: hdf5_bank_t ! Compound type for Bank + integer(HID_T), public :: hdf5_integer8_t ! type for integer(8) - ! Generic HDF5 write procedure interface - interface hdf5_write_data - module procedure hdf5_write_double - module procedure hdf5_write_double_1Darray - module procedure hdf5_write_double_2Darray - module procedure hdf5_write_double_3Darray - module procedure hdf5_write_double_4Darray - module procedure hdf5_write_integer - module procedure hdf5_write_integer_1Darray - module procedure hdf5_write_integer_2Darray - module procedure hdf5_write_integer_3Darray - module procedure hdf5_write_integer_4Darray - module procedure hdf5_write_long - module procedure hdf5_write_string -#ifdef PHDF5 - module procedure hdf5_write_double_parallel - module procedure hdf5_write_double_1Darray_parallel - module procedure hdf5_write_double_2Darray_parallel - module procedure hdf5_write_double_3Darray_parallel - module procedure hdf5_write_double_4Darray_parallel - module procedure hdf5_write_integer_parallel - module procedure hdf5_write_integer_1Darray_parallel - module procedure hdf5_write_integer_2Darray_parallel - module procedure hdf5_write_integer_3Darray_parallel - module procedure hdf5_write_integer_4Darray_parallel - module procedure hdf5_write_long_parallel - module procedure hdf5_write_string_parallel -#endif - end interface hdf5_write_data + interface write_dataset + module procedure write_double + module procedure write_double_1D + module procedure write_double_2D + module procedure write_double_3D + module procedure write_double_4D + module procedure write_integer + module procedure write_integer_1D + module procedure write_integer_2D + module procedure write_integer_3D + module procedure write_integer_4D + module procedure write_long + module procedure write_string + module procedure write_tally_result_1D + module procedure write_tally_result_2D + end interface write_dataset - ! Generic HDF5 read procedure interface - interface hdf5_read_data - module procedure hdf5_read_double - module procedure hdf5_read_double_1Darray - module procedure hdf5_read_double_2Darray - module procedure hdf5_read_double_3Darray - module procedure hdf5_read_double_4Darray - module procedure hdf5_read_integer - module procedure hdf5_read_integer_1Darray - module procedure hdf5_read_integer_2Darray - module procedure hdf5_read_integer_3Darray - module procedure hdf5_read_integer_4Darray - module procedure hdf5_read_long - module procedure hdf5_read_string -#ifdef PHDF5 - module procedure hdf5_read_double_parallel - module procedure hdf5_read_double_1Darray_parallel - module procedure hdf5_read_double_2Darray_parallel - module procedure hdf5_read_double_3Darray_parallel - module procedure hdf5_read_double_4Darray_parallel - module procedure hdf5_read_integer_parallel - module procedure hdf5_read_integer_1Darray_parallel - module procedure hdf5_read_integer_2Darray_parallel - module procedure hdf5_read_integer_3Darray_parallel - module procedure hdf5_read_integer_4Darray_parallel - module procedure hdf5_read_long_parallel - module procedure hdf5_read_string_parallel -#endif - end interface hdf5_read_data + interface read_dataset + module procedure read_double + module procedure read_double_1D + module procedure read_double_2D + module procedure read_double_3D + module procedure read_double_4D + module procedure read_integer + module procedure read_integer_1D + module procedure read_integer_2D + module procedure read_integer_3D + module procedure read_integer_4D + module procedure read_long + module procedure read_string + module procedure read_tally_result_1D + module procedure read_tally_result_2D + end interface read_dataset + + public :: write_dataset + public :: read_dataset + public :: file_create + public :: file_open + public :: file_close + public :: open_group + public :: close_group + public :: write_source_bank + public :: read_source_bank + public :: write_attribute_string contains !=============================================================================== -! HDF5_FILE_CREATE creates HDF5 file +! FILE_CREATE creates HDF5 file !=============================================================================== - subroutine hdf5_file_create(filename, file_id) + function file_create(filename, parallel) result(file_id) + character(*), intent(in) :: filename ! name of file + logical, optional, intent(in) :: parallel ! whether to write in serial + integer(HID_T) :: file_id - character(*), intent(in) :: filename ! name of file - integer(HID_T), intent(inout) :: file_id ! file handle + integer(HID_T) :: plist ! property list handle + integer :: hdf5_err ! HDF5 error code + logical :: parallel_ - ! Create the file - call h5fcreate_f(trim(filename), H5F_ACC_TRUNC_F, file_id, hdf5_err) + ! Check for serial option + if (present(parallel)) then + parallel_ = parallel + else + parallel_ = .false. + end if - end subroutine hdf5_file_create + if (parallel_) then + ! Setup file access property list with parallel I/O access + call h5pcreate_f(H5P_FILE_ACCESS_F, plist, hdf5_err) +#ifdef PHDF5 +#ifdef MPIF08 + call h5pset_fapl_mpio_f(plist, MPI_COMM_WORLD%MPI_VAL, & + MPI_INFO_NULL%MPI_VAL, hdf5_err) +#else + call h5pset_fapl_mpio_f(plist, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) +#endif +#endif + + ! Create the file collectively + call h5fcreate_f(trim(filename), H5F_ACC_TRUNC_F, file_id, hdf5_err, & + access_prp = plist) + + ! Close the property list + call h5pclose_f(plist, hdf5_err) + else + ! Create the file + call h5fcreate_f(trim(filename), H5F_ACC_TRUNC_F, file_id, hdf5_err) + end if + + end function file_create !=============================================================================== -! HDF5_FILE_OPEN opens HDF5 file +! FILE_OPEN opens HDF5 file !=============================================================================== - subroutine hdf5_file_open(filename, file_id, mode) + function file_open(filename, mode, parallel) result(file_id) + character(*), intent(in) :: filename ! name of file + character(*), intent(in) :: mode ! access mode to file + logical, optional, intent(in) :: parallel ! whether to write in serial + integer(HID_T) :: file_id - character(*), intent(in) :: filename ! name of file - character(*), intent(in) :: mode ! access mode to file - integer(HID_T), intent(inout) :: file_id ! file handle + logical :: parallel_ + integer(HID_T) :: plist ! property list handle + integer :: hdf5_err ! HDF5 error code + integer :: open_mode ! HDF5 open mode - integer :: open_mode ! HDF5 open mode + ! Check for serial option + if (present(parallel)) then + parallel_ = parallel + else + parallel_ = .false. + end if ! Determine access type open_mode = H5F_ACC_RDONLY_F - if (trim(mode) == 'w') 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 - -!=============================================================================== -! HDF5_FILE_CLOSE closes HDF5 file -!=============================================================================== - - subroutine hdf5_file_close(file_id) - - integer(HID_T), intent(inout) :: file_id ! file handle - - ! Close the file - call h5fclose_f(file_id, hdf5_err) - - end subroutine hdf5_file_close + if (trim(mode) == 'w') open_mode = H5F_ACC_RDWR_F + if (parallel_) then + ! Setup file access property list with parallel I/O access + call h5pcreate_f(H5P_FILE_ACCESS_F, plist, hdf5_err) #ifdef PHDF5 - -!=============================================================================== -! HDF5_FILE_CREATE_PARALLEL creates HDF5 file with parallel I/O -!=============================================================================== - - subroutine hdf5_file_create_parallel(filename, file_id) - - character(*), intent(in) :: filename ! name of file - integer(HID_T), intent(inout) :: file_id ! file handle - - ! Setup file access property list with parallel I/O access - call h5pcreate_f(H5P_FILE_ACCESS_F, plist, hdf5_err) #ifdef MPIF08 - call h5pset_fapl_mpio_f(plist, MPI_COMM_WORLD%MPI_VAL, & - MPI_INFO_NULL%MPI_VAL, hdf5_err) + call h5pset_fapl_mpio_f(plist, MPI_COMM_WORLD%MPI_VAL, & + MPI_INFO_NULL%MPI_VAL, hdf5_err) #else - call h5pset_fapl_mpio_f(plist, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) + call h5pset_fapl_mpio_f(plist, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) +#endif #endif - ! Create the file collectively - call h5fcreate_f(trim(filename), H5F_ACC_TRUNC_F, file_id, hdf5_err, & + ! Open the file collectively + call h5fopen_f(trim(filename), open_mode, file_id, hdf5_err, & access_prp = plist) - ! Close the property list - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_file_create_parallel - -!=============================================================================== -! HDF5_FILE_OPEN_PARALLEL opens HDF5 file with parallel I/O -!=============================================================================== - - subroutine hdf5_file_open_parallel(filename, file_id, mode) - - character(*), intent(in) :: filename ! name of file - character(*), intent(in) :: mode ! access mode - integer(HID_T), intent(inout) :: file_id ! file handle - - integer :: open_mode ! HDF5 access mode - - ! Setup file access property list with parallel I/O access - call h5pcreate_f(H5P_FILE_ACCESS_F, plist, hdf5_err) -#ifdef MPIF08 - call h5pset_fapl_mpio_f(plist, MPI_COMM_WORLD%MPI_VAL, & - MPI_INFO_NULL%MPI_VAL, hdf5_err) -#else - call h5pset_fapl_mpio_f(plist, MPI_COMM_WORLD, MPI_INFO_NULL, hdf5_err) -#endif - - ! Determine access type - open_mode = H5F_ACC_RDONLY_F - if (trim(mode) == 'w') then - open_mode = H5F_ACC_RDWR_F + ! Close the property list + call h5pclose_f(plist, hdf5_err) + else + ! Open file + call h5fopen_f(trim(filename), open_mode, file_id, hdf5_err) end if - ! Create the file collectively - call h5fopen_f(trim(filename), open_mode, file_id, hdf5_err, & - access_prp = plist) - - ! Close the property list - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_file_open_parallel - -#endif + end function file_open !=============================================================================== -! HDF5_OPEN_GROUP creates/opens HDF5 group to temp_group +! FILE_CLOSE closes HDF5 file !=============================================================================== - subroutine hdf5_open_group(hdf5_fh, group, hdf5_grp) + subroutine file_close(file_id) + integer(HID_T), intent(in) :: file_id - character(*), intent(in) :: group ! name of group - integer(HID_T), intent(in) :: hdf5_fh ! file handle of main output file - integer(HID_T), intent(inout) :: hdf5_grp ! handle for group + integer :: hdf5_err - logical :: status ! does the group exist + call h5fclose_f(file_id, hdf5_err) + end subroutine file_close + +!=============================================================================== +! OPEN_GROUP opens an existing HDF5 group +!=============================================================================== + + function open_group(group_id, name) result(newgroup_id) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of group + integer(HID_T) :: newgroup_id + + logical :: exists ! does the group exist + integer :: hdf5_err ! HDF5 error code ! Check if group exists - call h5ltpath_valid_f(hdf5_fh, trim(group), .true., status, hdf5_err) + call h5ltpath_valid_f(group_id, trim(name), .true., exists, hdf5_err) ! Either create or open group - if (status) then - call h5gopen_f(hdf5_fh, trim(group), hdf5_grp, hdf5_err) - else - call h5gcreate_f(hdf5_fh, trim(group), hdf5_grp, hdf5_err) + if (exists) call h5gopen_f(group_id, trim(name), newgroup_id, hdf5_err) + end function open_group + +!=============================================================================== +! CREATE_GROUP creates a new HDF5 group +!=============================================================================== + + function create_group(group_id, name) result(newgroup_id) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of group + integer(HID_T) :: newgroup_id + + integer :: hdf5_err ! HDF5 error code + logical :: exists ! does the group exist + + ! Check if group exists + call h5ltpath_valid_f(group_id, trim(name), .true., exists, hdf5_err) + + ! create group + if (.not. exists) & + call h5gcreate_f(group_id, trim(name), newgroup_id, hdf5_err) + end function create_group + +!=============================================================================== +! CLOSE_GROUP closes HDF5 temp_group +!=============================================================================== + + subroutine close_group(group_id) + integer(HID_T), intent(inout) :: group_id + + integer :: hdf5_err ! HDF5 error code + + call h5gclose_f(group_id, hdf5_err) + end subroutine close_group + +!=============================================================================== +! WRITE_DOUBLE writes double precision scalar data +!=============================================================================== + + subroutine write_double(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name for data + real(8), intent(in), target :: buffer ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up independentive vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F end if - end subroutine hdf5_open_group - -!=============================================================================== -! HDF5_CLOSE_GROUP closes HDF5 temp_group -!=============================================================================== - - subroutine hdf5_close_group(hdf5_grp) - - integer(HID_T), intent(inout) :: hdf5_grp - - ! Close the group - call h5gclose_f(hdf5_grp, hdf5_err) - - end subroutine hdf5_close_group - -!=============================================================================== -! HDF5_WRITE_INTEGER writes integer scalar data -!=============================================================================== - - subroutine hdf5_write_integer(group, name, buffer) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, target, intent(in) :: buffer ! data to write - - ! Create space, dataset, and write - call h5screate_f(H5S_SCALAR_F, dspace, hdf5_err) - call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) - f_ptr = c_loc(buffer) - call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - - end subroutine hdf5_write_integer - -!=============================================================================== -! HDF5_READ_INTEGER reads integer scalar data -!=============================================================================== - - subroutine hdf5_read_integer(group, name, buffer) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, target, intent(inout) :: buffer ! read data to here - - call h5dopen_f(group, name, dset, hdf5_err) - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) - call h5dclose_f(dset, hdf5_err) - - end subroutine hdf5_read_integer - -!=============================================================================== -! HDF5_WRITE_INTEGER_1DARRAY writes integer 1-D array -!=============================================================================== - - subroutine hdf5_write_integer_1Darray(group, name, buffer, len) - - 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 - - ! Set rank and dimensions of data - hdf5_rank = 1 - dims1(1) = len - - ! Write data - call h5ltmake_dataset_int_f(group, name, hdf5_rank, dims1, & - buffer, hdf5_err) - - end subroutine hdf5_write_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 ! name of group - character(*), intent(in) :: name ! name of data - integer, intent(inout) :: buffer(:) ! read data to here - integer, intent(in) :: length ! length of array - - ! Set dimensions - dims1(1) = length - - ! Read data - call h5ltread_dataset_int_f(group, name, buffer, dims1, hdf5_err) - - end subroutine hdf5_read_integer_1Darray - -!=============================================================================== -! HDF5_WRITE_INTEGER_2DARRAY writes integer 2-D array -!=============================================================================== - - subroutine hdf5_write_integer_2Darray(group, name, buffer, length) - - 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 - - ! Set rank and dimensions - hdf5_rank = 2 - dims2 = length - - ! Write data - call h5ltmake_dataset_int_f(group, name, hdf5_rank, dims2, & - buffer, hdf5_err) - - end subroutine hdf5_write_integer_2Darray - -!=============================================================================== -! HDF5_READ_INTEGER_2DARRAY reads integer 2-D array -!=============================================================================== - - subroutine hdf5_read_integer_2Darray(group, name, buffer, length) - - integer, intent(in) :: length(2) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, intent(inout) :: buffer(length(1),length(2)) ! data to read - - ! Set rank and dimensions - dims2 = length - - ! Write data - call h5ltread_dataset_int_f(group, name, buffer, dims2, hdf5_err) - - end subroutine hdf5_read_integer_2Darray - -!=============================================================================== -! HDF5_WRITE_INTEGER_3DARRAY writes integer 3-D array -!=============================================================================== - - subroutine hdf5_write_integer_3Darray(group, name, buffer, length) - - integer, intent(in) :: length(3) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, intent(in) :: buffer(length(1),length(2), & - length(3)) ! data to write - - ! Set rank and dimensions - hdf5_rank = 3 - dims3 = length - - ! Write data - call h5ltmake_dataset_int_f(group, name, hdf5_rank, dims3, & - buffer, hdf5_err) - - end subroutine hdf5_write_integer_3Darray - -!=============================================================================== -! HDF5_READ_INTEGER_3DARRAY reads integer 3-D array -!=============================================================================== - - subroutine hdf5_read_integer_3Darray(group, name, buffer, length) - - integer, intent(in) :: length(3) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, intent(inout) :: buffer(length(1),length(2), & - length(3)) ! data to read - - ! Set rank and dimensions - dims3 = length - - ! Write data - call h5ltread_dataset_int_f(group, name, buffer, dims3, hdf5_err) - - end subroutine hdf5_read_integer_3Darray - -!=============================================================================== -! HDF5_WRITE_INTEGER_4DARRAY writes integer 4-D array -!=============================================================================== - - subroutine hdf5_write_integer_4Darray(group, name, buffer, length) - - integer, intent(in) :: length(4) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, intent(in) :: buffer(length(1),length(2), & - length(3),length(4)) ! data to write - - ! Set rank and dimensions - hdf5_rank = 4 - dims4 = length - - ! Write data - call h5ltmake_dataset_int_f(group, name, hdf5_rank, dims4, & - buffer, hdf5_err) - - end subroutine hdf5_write_integer_4Darray - -!=============================================================================== -! HDF5_READ_INTEGER_4DARRAY reads integer 4-D array -!=============================================================================== - - subroutine hdf5_read_integer_4Darray(group, name, buffer, length) - - integer, intent(in) :: length(4) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, intent(inout) :: buffer(length(1),length(2), & - length(3),length(4)) ! data to read - - ! Set rank and dimensions - dims4 = length - - ! Write data - call h5ltread_dataset_int_f(group, name, buffer, dims4, hdf5_err) - - end subroutine hdf5_read_integer_4Darray - -!=============================================================================== -! HDF5_WRITE_DOUBLE writes integer scalar data -!=============================================================================== - - subroutine hdf5_write_double(group, name, buffer) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), target, intent(in) :: buffer ! data to write - - ! Create space, dataset, and write - call h5screate_f(H5S_SCALAR_F, dspace, hdf5_err) - call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) - f_ptr = c_loc(buffer) - call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - - end subroutine hdf5_write_double - -!=============================================================================== -! HDF5_READ_DOUBLE reads double scalar data -!=============================================================================== - - subroutine hdf5_read_double(group, name, buffer) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), target, intent(inout) :: buffer ! read data to here - - call h5dopen_f(group, name, dset, hdf5_err) - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) - call h5dclose_f(dset, hdf5_err) - - end subroutine hdf5_read_double - -!=============================================================================== -! HDF5_WRITE_DOUBLE_1DARRAY writes double 1-D array -!=============================================================================== - - subroutine hdf5_write_double_1Darray(group, name, buffer, length) - - integer, intent(in) :: length ! length of array to write - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer(:) ! data to write - - ! Set rank and dimensions of data - hdf5_rank = 1 - dims1(1) = length - - ! Write data - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims1, & - buffer, hdf5_err) - - end subroutine hdf5_write_double_1Darray - -!=============================================================================== -! HDF5_READ_DOUBLE_1DARRAY reads double 1-D array -!=============================================================================== - - subroutine hdf5_read_double_1Darray(group, name, buffer, length) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer(:) ! read data to here - integer, intent(in) :: length ! length of array - - ! Set dimensions - dims1(1) = length - - ! Read data - call h5ltread_dataset_double_f(group, name, buffer, dims1, hdf5_err) - - end subroutine hdf5_read_double_1Darray - -!=============================================================================== -! HDF5_WRITE_DOUBLE_2DARRAY writes double 2-D array -!=============================================================================== - - subroutine hdf5_write_double_2Darray(group, name, buffer, length) - - integer, intent(in) :: length(2) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer(length(1),length(2)) ! data to write - - ! Set rank and dimensions - hdf5_rank = 2 - dims2 = length - - ! Write data - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims2, & - buffer, hdf5_err) - - end subroutine hdf5_write_double_2Darray - -!=============================================================================== -! HDF5_READ_DOUBLE_2DARRAY reads double 2-D array -!=============================================================================== - - subroutine hdf5_read_double_2Darray(group, name, buffer, length) - - integer, intent(in) :: length(2) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer(length(1),length(2)) ! data to read - - ! Set rank and dimensions - dims2 = length - - ! Write data - call h5ltread_dataset_double_f(group, name, buffer, dims2, hdf5_err) - - end subroutine hdf5_read_double_2Darray - -!=============================================================================== -! HDF5_WRITE_DOUBLE_3DARRAY writes double 3-D array -!=============================================================================== - - subroutine hdf5_write_double_3Darray(group, name, buffer, length) - - integer, intent(in) :: length(3) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer(length(1),length(2), & - length(3)) ! data to write - - ! Set rank and dimensions - hdf5_rank = 3 - dims3 = length - - ! Write data - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims3, & - buffer, hdf5_err) - - end subroutine hdf5_write_double_3Darray - -!=============================================================================== -! HDF5_READ_DOUBLE_3DARRAY reads double 3-D array -!=============================================================================== - - subroutine hdf5_read_double_3Darray(group, name, buffer, length) - - integer, intent(in) :: length(3) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer(length(1),length(2), & - length(3)) ! data to read - - ! Set rank and dimensions - dims3 = length - - ! Write data - call h5ltread_dataset_double_f(group, name, buffer, dims3, hdf5_err) - - end subroutine hdf5_read_double_3Darray - -!=============================================================================== -! HDF5_WRITE_DOUBLE_4DARRAY writes double 4-D array -!=============================================================================== - - subroutine hdf5_write_double_4Darray(group, name, buffer, length) - - integer, intent(in) :: length(4) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(in) :: buffer(length(1),length(2), & - length(3),length(4)) ! data to write - - ! Set rank and dimensions - hdf5_rank = 4 - dims4 = length - - ! Write data - call h5ltmake_dataset_double_f(group, name, hdf5_rank, dims4, & - buffer, hdf5_err) - - end subroutine hdf5_write_double_4Darray - -!=============================================================================== -! HDF5_READ_DOUBLE_4DARRAY reads double 4-D array -!=============================================================================== - - subroutine hdf5_read_double_4Darray(group, name, buffer, length) - - integer, intent(in) :: length(4) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), intent(inout) :: buffer(length(1),length(2), & - length(3),length(4)) ! data to read - - ! Set rank and dimensions - dims4 = length - - ! Write data - call h5ltread_dataset_double_f(group, name, buffer, dims4, hdf5_err) - - end subroutine hdf5_read_double_4Darray - -!=============================================================================== -! HDF5_WRITE_LONG writes long integer scalar data -!=============================================================================== - - subroutine hdf5_write_long(group, name, buffer, long_type) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer(8), target, intent(in) :: buffer ! data to write - integer(HID_T), intent(in) :: long_type ! HDF5 long type - ! Create dataspace and dataset call h5screate_f(H5S_SCALAR_F, dspace, hdf5_err) - call h5dcreate_f(group, name, long_type, dspace, dset, hdf5_err) + call h5dcreate_f(group_id, trim(name), H5T_NATIVE_DOUBLE, & + dspace, dset, hdf5_err) f_ptr = c_loc(buffer) - call h5dwrite_f(dset, long_type, f_ptr, hdf5_err) - ! Close dataspace and dataset for long integer + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + end if + call h5dclose_f(dset, hdf5_err) call h5sclose_f(dspace, hdf5_err) - - end subroutine hdf5_write_long + end subroutine write_double !=============================================================================== -! HDF5_READ_LONG read long integer scalar data +! READ_DOUBLE reads double precision scalar data !=============================================================================== - subroutine hdf5_read_long(group, name, buffer, long_type) + subroutine read_double(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name for data + real(8), intent(inout), target :: buffer ! read data to here + logical, intent(in), optional :: indep ! independent I/O - 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 :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr - call h5dopen_f(group, name, dset, hdf5_err) + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) f_ptr = c_loc(buffer) - call h5dread_f(dset, long_type, f_ptr, hdf5_err) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + end if + call h5dclose_f(dset, hdf5_err) - - end subroutine hdf5_read_long + end subroutine read_double !=============================================================================== -! HDF5_WRITE_STRING writes string data +! WRITE_DOUBLE_1DARRAY writes double precision 1-D array data !=============================================================================== - subroutine hdf5_write_string(group, name, buffer, length) + subroutine write_double_1D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + real(8), intent(in), target :: buffer(:) ! data to write + logical, intent(in), optional :: indep ! independent I/O - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - character(*), intent(in) :: buffer ! data to write - integer, intent(in) :: length + integer(HSIZE_T) :: dims(1) - character(len=length), dimension(1) :: str_tmp + dims(:) = shape(buffer) + if (present(indep)) then + call write_double_1D_explicit(group_id, dims, name, buffer, indep) + else + call write_double_1D_explicit(group_id, dims, name, buffer) + end if + end subroutine write_double_1D -! 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)) + subroutine write_double_1D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(1) + character(*), intent(in) :: name ! name of data + real(8), intent(in), target :: buffer(dims(1)) ! data to write + logical, intent(in), optional :: indep ! independent I/O - ! Number of strings to write - dims1(1) = 1 + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5screate_simple_f(1, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, trim(name), H5T_NATIVE_DOUBLE, & + dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end subroutine write_double_1D_explicit + +!=============================================================================== +! READ_DOUBLE_1DARRAY reads double precision 1-D array data +!=============================================================================== + + subroutine read_double_1D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + real(8), intent(inout), target :: buffer(:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(1) + + dims(:) = shape(buffer) + if (present(indep)) then + call read_double_1D_explicit(group_id, dims, name, buffer, indep) + else + call read_double_1D_explicit(group_id, dims, name, buffer) + end if + end subroutine read_double_1D + + subroutine read_double_1D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(1) + character(*), intent(in) :: name ! name of data + real(8), intent(inout), target :: buffer(dims(1)) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + end subroutine read_double_1D_explicit + +!=============================================================================== +! WRITE_DOUBLE_2DARRAY writes double precision 2-D array data +!=============================================================================== + + subroutine write_double_2D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + real(8), intent(in), target :: buffer(:,:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(2) + + dims(:) = shape(buffer) + if (present(indep)) then + call write_double_2D_explicit(group_id, dims, name, buffer, indep) + else + call write_double_2D_explicit(group_id, dims, name, buffer) + end if + end subroutine write_double_2D + + subroutine write_double_2D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(2) + character(*), intent(in) :: name ! name of data + real(8), intent(in), target :: buffer(dims(1),dims(2)) + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5screate_simple_f(2, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, trim(name), H5T_NATIVE_DOUBLE, & + dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end subroutine write_double_2D_explicit + +!=============================================================================== +! READ_DOUBLE_2DARRAY reads double precision 2-D array data +!=============================================================================== + + subroutine read_double_2D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + real(8), intent(inout), target :: buffer(:,:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(2) + + dims(:) = shape(buffer) + if (present(indep)) then + call read_double_2D_explicit(group_id, dims, name, buffer, indep) + else + call read_double_2D_explicit(group_id, dims, name, buffer) + end if + end subroutine read_double_2D + + subroutine read_double_2D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(2) + character(*), intent(in) :: name ! name of data + real(8), intent(inout), target :: buffer(dims(1),dims(2)) + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + end subroutine read_double_2D_explicit + +!=============================================================================== +! WRITE_DOUBLE_3DARRAY writes double precision 3-D array data +!=============================================================================== + + subroutine write_double_3D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + real(8), intent(in), target :: buffer(:,:,:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(3) + + dims(:) = shape(buffer) + if (present(indep)) then + call write_double_3D_explicit(group_id, dims, name, buffer, indep) + else + call write_double_3D_explicit(group_id, dims, name, buffer) + end if + end subroutine write_double_3D + + subroutine write_double_3D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(3) + character(*), intent(in) :: name ! name of data + real(8), intent(in), target :: buffer(dims(1),dims(2),dims(3)) + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5screate_simple_f(3, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, trim(name), H5T_NATIVE_DOUBLE, & + dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end subroutine write_double_3D_explicit + +!=============================================================================== +! READ_DOUBLE_3DARRAY reads double precision 3-D array data +!=============================================================================== + + subroutine read_double_3D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + real(8), intent(inout), target :: buffer(:,:,:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(3) + + dims(:) = shape(buffer) + if (present(indep)) then + call read_double_3D_explicit(group_id, dims, name, buffer, indep) + else + call read_double_3D_explicit(group_id, dims, name, buffer) + end if + end subroutine read_double_3D + + subroutine read_double_3D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(3) + character(*), intent(in) :: name ! name of data + real(8), intent(inout), target :: buffer(dims(1),dims(2),dims(3)) + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + end subroutine read_double_3D_explicit + +!=============================================================================== +! WRITE_DOUBLE_4DARRAY writes double precision 4-D array data +!=============================================================================== + + subroutine write_double_4D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + real(8), intent(in), target :: buffer(:,:,:,:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(4) + + dims(:) = shape(buffer) + if (present(indep)) then + call write_double_4D_explicit(group_id, dims, name, buffer, indep) + else + call write_double_4D_explicit(group_id, dims, name, buffer) + end if + end subroutine write_double_4D + + subroutine write_double_4D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(4) + character(*), intent(in) :: name ! name of data + real(8), intent(in), target :: buffer(dims(1),dims(2),dims(3),dims(4)) + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5screate_simple_f(4, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, trim(name), H5T_NATIVE_DOUBLE, & + dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end subroutine write_double_4D_explicit + +!=============================================================================== +! READ_DOUBLE_4DARRAY reads double precision 4-D array data +!=============================================================================== + + subroutine read_double_4D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + real(8), intent(inout), target :: buffer(:,:,:,:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(4) + + dims(:) = shape(buffer) + if (present(indep)) then + call read_double_4D_explicit(group_id, dims, name, buffer, indep) + else + call read_double_4D_explicit(group_id, dims, name, buffer) + end if + end subroutine read_double_4D + + subroutine read_double_4D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(4) + character(*), intent(in) :: name ! name of data + real(8), intent(inout), target :: buffer(dims(1),dims(2),dims(3),dims(4)) + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + end subroutine read_double_4D_explicit + +!=============================================================================== +! WRITE_INTEGER writes integer precision scalar data +!=============================================================================== + + subroutine write_integer(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name for data + integer, intent(in), target :: buffer ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + ! Create dataspace and dataset + call h5screate_f(H5S_SCALAR_F, dspace, hdf5_err) + call h5dcreate_f(group_id, trim(name), H5T_NATIVE_INTEGER, & + dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end subroutine write_integer + +!=============================================================================== +! READ_INTEGER reads integer precision scalar data +!=============================================================================== + + subroutine read_integer(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name for data + integer, intent(inout), target :: buffer ! read data to here + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + end subroutine read_integer + +!=============================================================================== +! WRITE_INTEGER_1DARRAY writes integer precision 1-D array data +!=============================================================================== + + subroutine write_integer_1D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + integer, intent(in), target :: buffer(:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(1) + + dims(:) = shape(buffer) + if (present(indep)) then + call write_integer_1D_explicit(group_id, dims, name, buffer, indep) + else + call write_integer_1D_explicit(group_id, dims, name, buffer) + end if + end subroutine write_integer_1D + + subroutine write_integer_1D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(1) + character(*), intent(in) :: name ! name of data + integer, intent(in), target :: buffer(dims(1)) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5screate_simple_f(1, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, trim(name), H5T_NATIVE_INTEGER, & + dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end subroutine write_integer_1D_explicit + +!=============================================================================== +! READ_INTEGER_1DARRAY reads integer precision 1-D array data +!=============================================================================== + + subroutine read_integer_1D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + integer, intent(inout), target :: buffer(:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(1) + + dims(:) = shape(buffer) + if (present(indep)) then + call read_integer_1D_explicit(group_id, dims, name, buffer, indep) + else + call read_integer_1D_explicit(group_id, dims, name, buffer) + end if + end subroutine read_integer_1D + + subroutine read_integer_1D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(1) + character(*), intent(in) :: name ! name of data + integer, intent(inout), target :: buffer(dims(1)) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + end subroutine read_integer_1D_explicit + +!=============================================================================== +! WRITE_INTEGER_2DARRAY writes integer precision 2-D array data +!=============================================================================== + + subroutine write_integer_2D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + integer, intent(in), target :: buffer(:,:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(2) + + dims(:) = shape(buffer) + if (present(indep)) then + call write_integer_2D_explicit(group_id, dims, name, buffer, indep) + else + call write_integer_2D_explicit(group_id, dims, name, buffer) + end if + end subroutine write_integer_2D + + subroutine write_integer_2D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(2) + character(*), intent(in) :: name ! name of data + integer, intent(in), target :: buffer(dims(1),dims(2)) + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5screate_simple_f(2, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, trim(name), H5T_NATIVE_INTEGER, & + dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end subroutine write_integer_2D_explicit + +!=============================================================================== +! READ_INTEGER_2DARRAY reads integer precision 2-D array data +!=============================================================================== + + subroutine read_integer_2D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + integer, intent(inout), target :: buffer(:,:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(2) + + dims(:) = shape(buffer) + if (present(indep)) then + call read_integer_2D_explicit(group_id, dims, name, buffer, indep) + else + call read_integer_2D_explicit(group_id, dims, name, buffer) + end if + end subroutine read_integer_2D + + subroutine read_integer_2D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(2) + character(*), intent(in) :: name ! name of data + integer, intent(inout), target :: buffer(dims(1),dims(2)) + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + end subroutine read_integer_2D_explicit + +!=============================================================================== +! WRITE_INTEGER_3DARRAY writes integer precision 3-D array data +!=============================================================================== + + subroutine write_integer_3D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + integer, intent(in), target :: buffer(:,:,:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(3) + + dims(:) = shape(buffer) + if (present(indep)) then + call write_integer_3D_explicit(group_id, dims, name, buffer, indep) + else + call write_integer_3D_explicit(group_id, dims, name, buffer) + end if + end subroutine write_integer_3D + + subroutine write_integer_3D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(3) + character(*), intent(in) :: name ! name of data + integer, intent(in), target :: buffer(dims(1),dims(2),dims(3)) + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5screate_simple_f(3, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, trim(name), H5T_NATIVE_INTEGER, & + dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end subroutine write_integer_3D_explicit + +!=============================================================================== +! READ_INTEGER_3DARRAY reads integer precision 3-D array data +!=============================================================================== + + subroutine read_integer_3D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + integer, intent(inout), target :: buffer(:,:,:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(3) + + dims(:) = shape(buffer) + if (present(indep)) then + call read_integer_3D_explicit(group_id, dims, name, buffer, indep) + else + call read_integer_3D_explicit(group_id, dims, name, buffer) + end if + end subroutine read_integer_3D + + subroutine read_integer_3D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(3) + character(*), intent(in) :: name ! name of data + integer, intent(inout), target :: buffer(dims(1),dims(2),dims(3)) + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + end subroutine read_integer_3D_explicit + +!=============================================================================== +! WRITE_INTEGER_4DARRAY writes integer precision 4-D array data +!=============================================================================== + + subroutine write_integer_4D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + integer, intent(in), target :: buffer(:,:,:,:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(4) + + dims(:) = shape(buffer) + if (present(indep)) then + call write_integer_4D_explicit(group_id, dims, name, buffer, indep) + else + call write_integer_4D_explicit(group_id, dims, name, buffer) + end if + end subroutine write_integer_4D + + subroutine write_integer_4D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(4) + character(*), intent(in) :: name ! name of data + integer, intent(in), target :: buffer(dims(1),dims(2),dims(3),dims(4)) + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5screate_simple_f(4, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, trim(name), H5T_NATIVE_INTEGER, & + dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end subroutine write_integer_4D_explicit + +!=============================================================================== +! READ_INTEGER_4DARRAY reads integer precision 4-D array data +!=============================================================================== + + subroutine read_integer_4D(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + integer, intent(inout), target :: buffer(:,:,:,:) ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer(HSIZE_T) :: dims(4) + + dims(:) = shape(buffer) + if (present(indep)) then + call read_integer_4D_explicit(group_id, dims, name, buffer, indep) + else + call read_integer_4D_explicit(group_id, dims, name, buffer) + end if + end subroutine read_integer_4D + + subroutine read_integer_4D_explicit(group_id, dims, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(4) + character(*), intent(in) :: name ! name of data + integer, intent(inout), target :: buffer(dims(1),dims(2),dims(3),dims(4)) + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + end subroutine read_integer_4D_explicit + +!=============================================================================== +! WRITE_LONG writes long integer scalar data +!=============================================================================== + + subroutine write_long(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name for data + integer(8), intent(in), target :: buffer ! data to write + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + ! Create dataspace and dataset + call h5screate_f(H5S_SCALAR_F, dspace, hdf5_err) + call h5dcreate_f(group_id, trim(name), hdf5_integer8_t, & + dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dwrite_f(dset, hdf5_integer8_t, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dwrite_f(dset, hdf5_integer8_t, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end subroutine write_long + +!=============================================================================== +! READ_LONG reads long integer scalar data +!=============================================================================== + + subroutine read_long(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name for data + integer(8), intent(inout), target :: buffer ! read data to here + logical, intent(in), optional :: indep ! independent I/O + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) + f_ptr = c_loc(buffer) + + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dread_f(dset, hdf5_integer8_t, f_ptr, hdf5_err, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dread_f(dset, hdf5_integer8_t, f_ptr, hdf5_err) + end if + + call h5dclose_f(dset, hdf5_err) + end subroutine read_long + +!=============================================================================== +! WRITE_STRING writes string data +!=============================================================================== + + subroutine write_string(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name for data + character(*), intent(in) :: buffer ! read data to here + logical, intent(in), optional :: indep ! independent I/O + + integer :: n + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + integer(HSIZE_T) :: dims1(1) + integer(HSIZE_T) :: dims2(2) + type(c_ptr) :: f_ptr + character(len=len_trim(buffer)), dimension(1) :: str_tmp + + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if ! 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 + dims1(1) = 1 call h5screate_simple_f(1, dims1, dspace, hdf5_err) - call h5dcreate_f(group, name, H5T_STRING, dspace, dset, hdf5_err) + call h5dcreate_f(group_id, trim(name), H5T_STRING, dspace, dset, hdf5_err) ! Set up dimesnions of string to write - dims2 = (/length, 1/) ! full array of strings to write - dims1(1) = length ! length of string + n = len_trim(buffer) + dims2(:) = [n, 1] ! full array of strings to write + dims1(1) = n ! 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) + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dwrite_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, & + mem_space_id=dspace, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dwrite_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, & + mem_space_id=dspace) + end if - ! Close all call h5dclose_f(dset, hdf5_err) call h5sclose_f(dspace, hdf5_err) - - end subroutine hdf5_write_string + end subroutine write_string !=============================================================================== -! HDF5_READ_STRING reads string data +! READ_STRING reads string data !=============================================================================== - subroutine hdf5_read_string(group, name, buffer, length) + subroutine read_string(group_id, name, buffer, indep) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name for data + character(*), intent(inout) :: buffer ! read data to here + logical, intent(in), optional :: indep ! independent I/O - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - character(*), intent(inout) :: buffer ! read data to here - integer, intent(in) :: length ! length of string to read + integer :: n + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + integer(HSIZE_T) :: dims1(1) + integer(HSIZE_T) :: dims2(2) + type(c_ptr) :: f_ptr + character(len=len_trim(buffer)), dimension(1) :: str_tmp - character(len=length), dimension(1) :: str_tmp + ! Set up collective vs. independent I/O + data_xfer_mode = H5FD_MPIO_COLLECTIVE_F + if (present(indep)) then + if (indep) data_xfer_mode = H5FD_MPIO_INDEPENDENT_F + end if - ! 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) + ! Set up dimesnions of string to write + n = len_trim(buffer) + dims2(:) = [n, 1] ! full array of strings to write + dims1(1) = n ! length of string - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Get dataspace to read + call h5dopen_f(group_id, trim(name), dset, hdf5_err) call h5dget_space_f(dset, dspace, hdf5_err) - ! Set dimensions - dims2 = (/length, 1/) - dims1(1) = length - - ! Read in the data - call h5dread_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, & - mem_space_id=dspace, xfer_prp = plist) + if (using_mpio_device(group_id)) then +#ifdef PHDF5 + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, data_xfer_mode, hdf5_err) + call h5dread_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, & + mem_space_id=dspace, xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#endif + else + call h5dread_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, & + mem_space_id=dspace) + end if ! Copy over buffer buffer = str_tmp(1) ! Close dataset call h5dclose_f(dset, hdf5_err) - - end subroutine hdf5_read_string + end subroutine read_string !=============================================================================== -! HDF5_WRITE_ATTRIBUTE_STRING writes a string attribute to a variables +! WRITE_ATTRIBUTE_STRING !=============================================================================== - subroutine hdf5_write_attribute_string(group, var, attr_type, attr_str) + subroutine write_attribute_string(group_id, var, attr_type, attr_str) + integer(HID_T), intent(in) :: group_id + 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 - 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 + integer :: hdf5_err - call h5ltset_attribute_string_f(group, var, attr_type, attr_str, hdf5_err) + call h5ltset_attribute_string_f(group_id, var, attr_type, attr_str, hdf5_err) + end subroutine write_attribute_string - end subroutine hdf5_write_attribute_string +!=============================================================================== +! WRITE_TALLY_RESULT writes an OpenMC TallyResult type +!=============================================================================== + + subroutine write_tally_result_1D(group_id, name, buffer) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + type(TallyResult), intent(in), target :: buffer(:) ! data to write + + integer(HSIZE_T) :: dims(1) + + dims(:) = shape(buffer) + call write_tally_result_1D_explicit(group_id, dims, name, buffer) + end subroutine write_tally_result_1D + + subroutine write_tally_result_1D_explicit(group_id, dims, name, buffer) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(1) + character(*), intent(in) :: name ! name of data + type(TallyResult), intent(in), target :: buffer(dims(1)) + + integer :: hdf5_err + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + call h5screate_simple_f(1, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, trim(name), hdf5_tallyresult_t, & + dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end subroutine write_tally_result_1D_explicit + + subroutine write_tally_result_2D(group_id, name, buffer) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + type(TallyResult), intent(in), target :: buffer(:,:) ! data to write + + integer(HSIZE_T) :: dims(2) + + dims(:) = shape(buffer) + call write_tally_result_2D_explicit(group_id, dims, name, buffer) + end subroutine write_tally_result_2D + + subroutine write_tally_result_2D_explicit(group_id, dims, name, buffer) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(2) + character(*), intent(in) :: name ! name of data + type(TallyResult), intent(in), target :: buffer(dims(1),dims(2)) + + integer :: hdf5_err + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + type(c_ptr) :: f_ptr + + call h5screate_simple_f(2, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, trim(name), hdf5_tallyresult_t, & + dspace, dset, hdf5_err) + f_ptr = c_loc(buffer) + call h5dwrite_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + call h5dclose_f(dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end subroutine write_tally_result_2D_explicit + +!=============================================================================== +! READ_TALLY_RESULT reads OpenMC TallyResult data +!=============================================================================== + + subroutine read_tally_result_1D(group_id, name, buffer) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + type(TallyResult), intent(inout), target :: buffer(:) ! read data here + + integer(HSIZE_T) :: dims(1) + + dims(:) = shape(buffer) + call read_tally_result_1D_explicit(group_id, dims, name, buffer) + end subroutine read_tally_result_1D + + subroutine read_tally_result_1D_explicit(group_id, dims, name, buffer) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(1) + character(*), intent(in) :: name ! name of data + type(TallyResult), intent(inout), target :: buffer(dims(1)) + + integer :: hdf5_err + integer(HID_T) :: dset ! data set handle + type(c_ptr) :: f_ptr + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) + f_ptr = c_loc(buffer) + call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + call h5dclose_f(dset, hdf5_err) + end subroutine read_tally_result_1D_explicit + + subroutine read_tally_result_2D(group_id, name, buffer) + integer(HID_T), intent(in) :: group_id + character(*), intent(in) :: name ! name of data + type(TallyResult), intent(inout), target :: buffer(:,:) + + integer(HSIZE_T) :: dims(2) + + dims(:) = shape(buffer) + call read_tally_result_2D_explicit(group_id, dims, name, buffer) + end subroutine read_tally_result_2D + + subroutine read_tally_result_2D_explicit(group_id, dims, name, buffer) + integer(HID_T), intent(in) :: group_id + integer(HSIZE_T), intent(in) :: dims(2) + character(*), intent(in) :: name ! name of data + type(TallyResult), intent(inout), target :: buffer(dims(1),dims(2)) + + integer :: hdf5_err + integer(HID_T) :: dset ! data set handle + type(c_ptr) :: f_ptr + + call h5dopen_f(group_id, trim(name), dset, hdf5_err) + f_ptr = c_loc(buffer) + call h5dread_f(dset, hdf5_tallyresult_t, f_ptr, hdf5_err) + call h5dclose_f(dset, hdf5_err) + end subroutine read_tally_result_2D_explicit + +!=============================================================================== +! WRITE_SOURCE_BANK writes OpenMC source_bank data +!=============================================================================== + + subroutine write_source_bank(group_id) + use bank_header, only: Bank + use global, only: n_particles, work, source_bank + + integer(HID_T), intent(in) :: group_id + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + integer(HID_T) :: memspace ! memory space handle + integer(HSIZE_T) :: dims(1) + type(c_ptr) :: f_ptr +#ifdef PHDF5 + integer(HSIZE_T) :: offset(1) ! source data offset +#endif #ifdef PHDF5 - -!=============================================================================== -! HDF5_WRITE_INTEGER_PARALLEL writes integer scalar data in parallel -!=============================================================================== - - subroutine hdf5_write_integer_parallel(group, name, buffer, collect) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer,target, intent(in) :: buffer ! data to write - logical, intent(in) :: collect ! collect I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Create dataspace - call h5screate_f(H5S_SCALAR_F, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) - - ! Write data - f_ptr = c_loc(buffer) - call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close all - call h5dclose_f(dset, hdf5_err) + ! Set size of total dataspace for all procs and rank + dims(1) = n_particles + call h5screate_simple_f(1, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, "source_bank", hdf5_bank_t, dspace, dset, hdf5_err) call h5sclose_f(dspace, hdf5_err) - call h5pclose_f(plist, hdf5_err) - end subroutine hdf5_write_integer_parallel + ! Create another data space but for each proc individually + dims(1) = work + call h5screate_simple_f(rank, dims, memspace, hdf5_err) -!=============================================================================== -! HDF5_READ_INTEGER_PARALLEL reads integer scalar data -!=============================================================================== - - subroutine hdf5_read_integer_parallel(group, name, buffer, collect) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, target, intent(inout) :: buffer ! read data to here - logical, intent(in) :: collect ! collective I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_read_integer_parallel - -!=============================================================================== -! HDF5_WRITE_INTEGER_1DARRAY_PARALLEL writes integer 1-D array in parallel -!=============================================================================== - - subroutine hdf5_write_integer_1Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length ! length of array to write - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer,target, intent(in) :: buffer(length) ! data to write - logical, intent(in) :: collect ! collect I/O - - ! Set rank and dimensions of data - hdf5_rank = 1 - dims1(1) = length - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Create dataspace - call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) - - ! Write data - f_ptr = c_loc(buffer) - call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_write_integer_1Darray_parallel - -!=============================================================================== -! HDF5_WRITE_INTEGER_1DARRAY_PARALLEL reads integer 1-D array in parallel -!=============================================================================== - - subroutine hdf5_read_integer_1Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length ! length of array - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer, target, intent(inout) :: buffer(length) ! read data to here - logical, intent(in) :: collect ! collective I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_read_integer_1Darray_parallel - -!=============================================================================== -! HDF5_WRITE_INTEGER_2DARRAY_PARALLEL writes integer 2-D array in parallel -!=============================================================================== - - subroutine hdf5_write_integer_2Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length(2) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer,target, intent(in) :: buffer(length(1),length(2)) ! data to write - logical, intent(in) :: collect ! collective I/O - - ! Set rank and dimensions - hdf5_rank = 2 - dims2 = length - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Create dataspace - call h5screate_simple_f(hdf5_rank, dims2, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) - - ! Write data - f_ptr = c_loc(buffer) - call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_write_integer_2Darray_parallel - -!=============================================================================== -! HDF5_READ_INTEGER_2DARRAY_PARALLEL reads integer 2-D array in parallel -!=============================================================================== - - subroutine hdf5_read_integer_2Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length(2) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer,target, intent(inout) :: buffer(length(1),length(2)) ! data to read - logical, intent(in) :: collect ! collect I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_read_integer_2Darray_parallel - -!=============================================================================== -! HDF5_WRITE_INTEGER_3DARRAY_PARALLEL writes integer 3-D array in parallel -!=============================================================================== - - subroutine hdf5_write_integer_3Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length(3) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer,target, intent(in) :: buffer(length(1),length(2), & - length(3)) ! data to write - logical, intent(in) :: collect ! collective I/O - - ! Set rank and dimensions - hdf5_rank = 3 - dims3 = length - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Create dataspace - call h5screate_simple_f(hdf5_rank, dims3, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) - - ! Write data - f_ptr = c_loc(buffer) - call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_write_integer_3Darray_parallel - -!=============================================================================== -! HDF5_READ_INTEGER_3DARRAY_PARALLEL reads integer 3-D array in parallel -!=============================================================================== - - subroutine hdf5_read_integer_3Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length(3) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer,target, intent(inout) :: buffer(length(1),length(2), & - length(3)) ! data to read - logical, intent(in) :: collect ! collective I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_read_integer_3Darray_parallel - -!=============================================================================== -! HDF5_WRITE_INTEGER_4DARRAY_PARALLEL writes integer 4-D array in parallel -!=============================================================================== - - subroutine hdf5_write_integer_4Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length(4) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer,target, intent(in) :: buffer(length(1),length(2), & - length(3),length(4)) ! data to write - logical, intent(in) :: collect ! collective I/O - - ! Set rank and dimensions - hdf5_rank = 4 - dims4 = length - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Create dataspace - call h5screate_simple_f(hdf5_rank, dims4, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(group, name, H5T_NATIVE_INTEGER, dspace, dset, hdf5_err) - - ! Write data - f_ptr = c_loc(buffer) - call h5dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_write_integer_4Darray_parallel - -!=============================================================================== -! HDF5_READ_INTEGER_4DARRAY_PARALLEL reads integer 4-D array in parallel -!=============================================================================== - - subroutine hdf5_read_integer_4Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length(4) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer,target, intent(inout) :: buffer(length(1),length(2), & - length(3),length(4)) ! data to read - logical, intent(in) :: collect ! collective I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_read_integer_4Darray_parallel - -!=============================================================================== -! HDF5_WRITE_DOUBLE_PARALLEL writes double scalar data in parallel -!=============================================================================== - - subroutine hdf5_write_double_parallel(group, name, buffer, collect) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8),target, intent(in) :: buffer ! data to write - logical, intent(in) :: collect ! collect I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Create dataspace - call h5screate_f(H5S_SCALAR_F, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) - - ! Write data - f_ptr = c_loc(buffer) - call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_write_double_parallel - -!=============================================================================== -! HDF5_READ_DOUBLE_PARALLEL reads double scalar data -!=============================================================================== - - subroutine hdf5_read_double_parallel(group, name, buffer, collect) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8), target, intent(inout) :: buffer ! read data to here - logical, intent(in) :: collect ! collective I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_read_double_parallel - -!=============================================================================== -! HDF5_WRITE_DOUBLE_1DARRAY_PARALLEL writes double 1-D array in parallel -!=============================================================================== - - subroutine hdf5_write_double_1Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length ! length of array to write - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8),target, intent(in) :: buffer(length) ! data to write - logical, intent(in) :: collect ! collect I/O - - ! Set rank and dimensions of data - hdf5_rank = 1 - dims1(1) = length - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Create dataspace - call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) - - ! Write data - f_ptr = c_loc(buffer) - call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_write_double_1Darray_parallel - -!=============================================================================== -! HDF5_WRITE_DOUBLE_1DARRAY_PARALLEL reads double 1-D array in parallel -!=============================================================================== - - subroutine hdf5_read_double_1Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length ! length of array - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8),target, intent(inout) :: buffer(length) ! read data to here - logical, intent(in) :: collect ! collective I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_read_double_1Darray_parallel - -!=============================================================================== -! HDF5_WRITE_DOUBLE_2DARRAY_PARALLEL writes double 2-D array in parallel -!=============================================================================== - - subroutine hdf5_write_double_2Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length(2) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8),target, intent(in) :: buffer(length(1),length(2)) ! data to write - logical, intent(in) :: collect ! collective I/O - - ! Set rank and dimensions - hdf5_rank = 2 - dims2 = length - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Create dataspace - call h5screate_simple_f(hdf5_rank, dims2, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) - - ! Write data - f_ptr = c_loc(buffer(1,1)) - call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_write_double_2Darray_parallel - -!=============================================================================== -! HDF5_READ_DOUBLE_2DARRAY_PARALLEL reads double 2-D array in parallel -!=============================================================================== - - subroutine hdf5_read_double_2Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length(2) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8),target, intent(inout) :: buffer(length(1),length(2)) ! data to read - logical, intent(in) :: collect ! collect I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_read_double_2Darray_parallel - -!=============================================================================== -! HDF5_WRITE_DOUBLE_3DARRAY_PARALLEL writes double 3-D array in parallel -!=============================================================================== - - subroutine hdf5_write_double_3Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length(3) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8),target, intent(in) :: buffer(length(1),length(2), & - length(3)) ! data to write - logical, intent(in) :: collect ! collective I/O - - ! Set rank and dimensions - hdf5_rank = 3 - dims3 = length - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Create dataspace - call h5screate_simple_f(hdf5_rank, dims3, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) - - ! Write data - f_ptr = c_loc(buffer) - call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_write_double_3Darray_parallel - -!=============================================================================== -! HDF5_READ_DOUBLE_3DARRAY_PARALLEL reads double 3-D array in parallel -!=============================================================================== - - subroutine hdf5_read_double_3Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length(3) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8),target, intent(inout) :: buffer(length(1),length(2), & - length(3)) ! data to read - logical, intent(in) :: collect ! collective I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_read_double_3Darray_parallel - -!=============================================================================== -! HDF5_WRITE_DOUBLE_4DARRAY_PARALLEL writes double 4-D array in parallel -!=============================================================================== - - subroutine hdf5_write_double_4Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length(4) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8),target, intent(in) :: buffer(length(1),length(2), & - length(3),length(4)) ! data to write - logical, intent(in) :: collect ! collective I/O - - ! Set rank and dimensions - hdf5_rank = 4 - dims4 = length - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Create dataspace - call h5screate_simple_f(hdf5_rank, dims4, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(group, name, H5T_NATIVE_DOUBLE, dspace, dset, hdf5_err) - - ! Write data - f_ptr = c_loc(buffer) - call h5dwrite_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_write_double_4Darray_parallel - -!=============================================================================== -! HDF5_READ_DOUBLE_4DARRAY_PARALLEL reads double 4-D array in parallel -!=============================================================================== - - subroutine hdf5_read_double_4Darray_parallel(group, name, buffer, length, & - collect) - - integer, intent(in) :: length(4) ! length of array dimensions - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - real(8),target, intent(inout) :: buffer(length(1),length(2), & - length(3),length(4)) ! data to read - logical, intent(in) :: collect ! collective I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - f_ptr = c_loc(buffer) - call h5dread_f(dset, H5T_NATIVE_DOUBLE, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close dataset and property list - call h5dclose_f(dset, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_read_double_4Darray_parallel - -!=============================================================================== -! HDF5_WRITE_LONG_PARALLEL writes long integer scalar data in parallel -!=============================================================================== - - subroutine hdf5_write_long_parallel(group, name, buffer, long_type, collect) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer(8), target, intent(in) :: buffer ! data to write - integer(HID_T), intent(in) :: long_type ! HDF5 long type - logical, intent(in) :: collect ! collective I/O - - ! Set up rank and dimensions - hdf5_rank = 1 - dims1(1) = 1 - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Create dataspace - call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(group, name, long_type, dspace, dset, hdf5_err) - - ! Write data - f_ptr = c_loc(buffer) - call h5dwrite_f(dset, long_type, f_ptr, hdf5_err, xfer_prp=plist) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_write_long_parallel - -!=============================================================================== -! HDF5_READ_LONG_PARALLEL read long integer scalar data in parallel -!=============================================================================== - - subroutine hdf5_read_long_parallel(group, name, buffer, long_type, collect) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - integer(8), target, intent(out) :: buffer ! read data to here - integer(HID_T), intent(in) :: long_type ! long integer type - logical, intent(in) :: collect ! collective I/O - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Read data - 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_read_long_parallel - -!=============================================================================== -! HDF5_WRITE_STRING_PARALLEL writes string data in parallel -!=============================================================================== - - subroutine hdf5_write_string_parallel(group, name, buffer, length, collect) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - character(*), intent(in) :: buffer ! data to write - integer, intent(in) :: length ! length of string - logical, intent(in) :: collect ! collective I/O - - 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)) - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Number of strings to write - dims1(1) = 1 - - ! Insert null character at end of string when writing - call h5tset_strpad_f(H5T_STRING, H5T_STR_NULLPAD_F, hdf5_err) - - ! Create the dataspace and dataset - call h5screate_simple_f(1, dims1, dspace, hdf5_err) - call h5dcreate_f(group, name, H5T_STRING, dspace, dset, hdf5_err) - - ! Set up dimesnions of string to write - dims2 = (/length, 1/) ! full array of strings to write - dims1(1) = length ! length of string - - ! Copy over string buffer to a rank 1 array - str_tmp(1) = buffer - - ! Write the variable dataset - call h5dwrite_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, & - mem_space_id=dspace, xfer_prp=plist) - - ! Close all - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) - call h5pclose_f(plist, hdf5_err) - - end subroutine hdf5_write_string_parallel - -!=============================================================================== -! HDF5_READ_STRING_PARALLEL reads string data in parallel -!=============================================================================== - - subroutine hdf5_read_string_parallel(group, name, buffer, length, collect) - - integer(HID_T), intent(in) :: group ! name of group - character(*), intent(in) :: name ! name of data - character(*), intent(inout) :: buffer ! read data to here - integer, intent(in) :: length ! length of string - logical, intent(in) :: collect ! collective I/O - - character(len=length), dimension(1) :: str_tmp - - ! Fortran 2003 implementation not compatible with IBM Feb 2013 compiler -! type(c_ptr), dimension(1), target :: buf_ptr -! character(len=length, kind=c_char), pointer :: chr_ptr -! f_ptr = c_loc(buf_ptr(1)) -! call h5dread_f(dset, H5T_STRING, f_ptr, hdf5_err, xfer_prp=plist) -! call c_f_pointer(buf_ptr(1), chr_ptr) -! buffer = chr_ptr -! nullify(chr_ptr) - - ! Create property list for independent or collective read - call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) - - ! Set independent or collective option - if (collect) then - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) - else - call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_INDEPENDENT_F, hdf5_err) - end if - - ! Open dataset - call h5dopen_f(group, name, dset, hdf5_err) - - ! Get dataspace to read + ! Get the individual local proc dataspace call h5dget_space_f(dset, dspace, hdf5_err) - ! Set dimensions - dims2 = (/length, 1/) - dims1(1) = length + ! Select hyperslab for this dataspace + offset(1) = work_index(rank) + call h5sselect_hyperslab_f(dspace, H5S_SELECT_SET_F, offset, dims, hdf5_err) - ! Read in the data - call h5dread_vl_f(dset, H5T_STRING, str_tmp, dims2, dims1, hdf5_err, & - mem_space_id=dspace, xfer_prp = plist) + ! 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) - ! Copy over buffer - buffer = str_tmp(1) + ! Set up pointer to data + f_ptr = c_loc(source_bank) - ! Close dataset and property list + ! 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) - end subroutine hdf5_read_string_parallel +#else + + ! Set size + dims(1) = work + + ! Create dataspace + call h5screate_simple_f(1, dims, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(group_id, "source_bank", hdf5_bank_t, & + dspace, dset, hdf5_err) + + ! Set up pointer to data + f_ptr = c_loc(source_bank) + + ! 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 + end subroutine write_source_bank + +!=============================================================================== +! READ_SOURCE_BANK reads OpenMC source_bank data +!=============================================================================== + + subroutine read_source_bank(group_id) + use bank_header, only: Bank + use global, only: work, source_bank + + integer(HID_T), intent(in) :: group_id + + integer :: hdf5_err + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data space handle + integer(HID_T) :: memspace ! memory space handle + integer(HSIZE_T) :: dims(1) + type(c_ptr) :: f_ptr +#ifdef PHDF5 + integer(HSIZE_T) :: offset(1) ! offset of data +#endif + +#ifdef PHDF5 + + ! Open the dataset + call h5dopen_f(group_id, "source_bank", dset, hdf5_err) + + ! Create another data space but for each proc individually + dims(1) = work + call h5screate_simple_f(1, 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) = work_index(rank) + 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) + + ! 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 + + ! Open dataset + call h5dopen_f(group_id, "source_bank", dset, hdf5_err) + + ! Set up pointer to data + f_ptr = c_loc(source_bank) + + ! 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 + + end subroutine read_source_bank + + function using_mpio_device(obj_id) result(mpio) + integer(HID_T), intent(in) :: obj_id + logical :: mpio + + integer :: hdf5_err + integer :: driver + integer(HID_T) :: file_id + integer(HID_T) :: fapl_id + + ! Determine file that this object is part of + call h5iget_file_id_f(obj_id, file_id, hdf5_err) + + ! Get file access property list + call h5fget_access_plist_f(file_id, fapl_id, hdf5_err) + + ! Get low-level driver identifier + call h5pget_driver_f(fapl_id, driver, hdf5_err) + + ! Close file access property list access + call h5pclose_f(fapl_id, hdf5_err) + + ! Close file access -- note that this only decreases the reference count so + ! that the file is not actually closed + call h5fclose_f(file_id, hdf5_err) + + mpio = (driver == H5FD_MPIO_F) + end function using_mpio_device + end module hdf5_interface diff --git a/src/tally_header.F90 b/src/tally_header.F90 index d20c3fea2..ca4e25fd8 100644 --- a/src/tally_header.F90 +++ b/src/tally_header.F90 @@ -2,6 +2,7 @@ module tally_header use constants, only: NONE, N_FILTER_TYPES use trigger_header, only: TriggerObject + use, intrinsic :: ISO_C_BINDING implicit none @@ -39,10 +40,10 @@ module tally_header ! TALLYRESULT provides accumulation of results in a particular tally bin !=============================================================================== - type TallyResult - real(8) :: value = 0. - real(8) :: sum = 0. - real(8) :: sum_sq = 0. + type, bind(C) :: TallyResult + real(C_DOUBLE) :: value = 0. + real(C_DOUBLE) :: sum = 0. + real(C_DOUBLE) :: sum_sq = 0. end type TallyResult !=============================================================================== From 2f18e4b57ec3e2216f85e463e0d795647ffa675e Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Thu, 3 Sep 2015 09:20:47 +0700 Subject: [PATCH 11/32] Refactored rest of code to use new HDF5_interface API --- src/finalize.F90 | 11 +- src/hdf5_interface.F90 | 222 +--- src/hdf5_summary.F90 | 814 +++++++-------- src/initialize.F90 | 313 +++--- src/output_interface.F90 | 1725 -------------------------------- src/particle_restart.F90 | 53 +- src/particle_restart_write.F90 | 42 +- src/source.F90 | 93 +- src/state_point.F90 | 828 ++++++++------- src/track_output.F90 | 53 +- 10 files changed, 1146 insertions(+), 3008 deletions(-) delete mode 100644 src/output_interface.F90 diff --git a/src/finalize.F90 b/src/finalize.F90 index b795cdb4f..86100d195 100644 --- a/src/finalize.F90 +++ b/src/finalize.F90 @@ -9,7 +9,8 @@ module finalize use message_passing #endif - use hdf5_interface, only: h5tclose_f, h5close_f, hdf5_err + use hdf5_interface, only: hdf5_bank_t, hdf5_tallyresult_t + use hdf5, only: h5tclose_f, h5close_f implicit none @@ -22,8 +23,10 @@ contains subroutine finalize_run() + integer :: hdf5_err + ! Start finalization timer - call time_finalize % start() + call time_finalize%start() if (run_mode /= MODE_PLOTTING .and. run_mode /= MODE_PARTICLE) then ! Calculate statistics for tallies and write to tallies.out @@ -37,8 +40,8 @@ contains end if ! Stop timers and show timing statistics - call time_finalize % stop() - call time_total % stop() + call time_finalize%stop() + call time_total%stop() if (master .and. (run_mode /= MODE_PLOTTING .and. & run_mode /= MODE_PARTICLE)) then call print_runtime() diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 041e948ff..1684c352b 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -64,10 +64,9 @@ module hdf5_interface public :: file_create public :: file_open public :: file_close + public :: create_group public :: open_group public :: close_group - public :: write_source_bank - public :: read_source_bank public :: write_attribute_string contains @@ -243,7 +242,9 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr @@ -287,9 +288,10 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -344,7 +346,9 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr @@ -404,9 +408,10 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -461,7 +466,9 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr @@ -521,9 +528,10 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -578,7 +586,9 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr @@ -638,9 +648,10 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -695,7 +706,9 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr @@ -755,9 +768,10 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -795,7 +809,9 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr @@ -839,9 +855,10 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -896,7 +913,9 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr @@ -956,9 +975,10 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -1013,7 +1033,9 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr @@ -1073,9 +1095,10 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -1130,7 +1153,9 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr @@ -1190,9 +1215,10 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -1247,7 +1273,9 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr @@ -1307,9 +1335,10 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -1347,7 +1376,9 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr @@ -1391,9 +1422,10 @@ contains integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data or file space handle type(c_ptr) :: f_ptr ! Set up collective vs. independent I/O @@ -1432,12 +1464,13 @@ contains integer :: n integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle integer(HSIZE_T) :: dims1(1) integer(HSIZE_T) :: dims2(2) - type(c_ptr) :: f_ptr character(len=len_trim(buffer)), dimension(1) :: str_tmp ! Set up collective vs. independent I/O @@ -1492,12 +1525,13 @@ contains integer :: n integer :: hdf5_err integer :: data_xfer_mode +#ifdef PHDF5 integer(HID_T) :: plist ! property list +#endif integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle integer(HSIZE_T) :: dims1(1) integer(HSIZE_T) :: dims2(2) - type(c_ptr) :: f_ptr character(len=len_trim(buffer)), dimension(1) :: str_tmp ! Set up collective vs. independent I/O @@ -1673,164 +1707,6 @@ contains call h5dclose_f(dset, hdf5_err) end subroutine read_tally_result_2D_explicit -!=============================================================================== -! WRITE_SOURCE_BANK writes OpenMC source_bank data -!=============================================================================== - - subroutine write_source_bank(group_id) - use bank_header, only: Bank - use global, only: n_particles, work, source_bank - - integer(HID_T), intent(in) :: group_id - - integer :: hdf5_err - integer :: data_xfer_mode - integer(HID_T) :: plist ! property list - integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data or file space handle - integer(HID_T) :: memspace ! memory space handle - integer(HSIZE_T) :: dims(1) - type(c_ptr) :: f_ptr -#ifdef PHDF5 - integer(HSIZE_T) :: offset(1) ! source data offset -#endif - -#ifdef PHDF5 - ! Set size of total dataspace for all procs and rank - dims(1) = n_particles - call h5screate_simple_f(1, dims, dspace, hdf5_err) - call h5dcreate_f(group_id, "source_bank", hdf5_bank_t, dspace, dset, hdf5_err) - 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) = work_index(rank) - 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) - - ! 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 - - ! Set size - dims(1) = work - - ! Create dataspace - call h5screate_simple_f(1, dims, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(group_id, "source_bank", hdf5_bank_t, & - dspace, dset, hdf5_err) - - ! Set up pointer to data - f_ptr = c_loc(source_bank) - - ! 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 - - end subroutine write_source_bank - -!=============================================================================== -! READ_SOURCE_BANK reads OpenMC source_bank data -!=============================================================================== - - subroutine read_source_bank(group_id) - use bank_header, only: Bank - use global, only: work, source_bank - - integer(HID_T), intent(in) :: group_id - - integer :: hdf5_err - integer :: data_xfer_mode - integer(HID_T) :: plist ! property list - integer(HID_T) :: dset ! data set handle - integer(HID_T) :: dspace ! data space handle - integer(HID_T) :: memspace ! memory space handle - integer(HSIZE_T) :: dims(1) - type(c_ptr) :: f_ptr -#ifdef PHDF5 - integer(HSIZE_T) :: offset(1) ! offset of data -#endif - -#ifdef PHDF5 - - ! Open the dataset - call h5dopen_f(group_id, "source_bank", dset, hdf5_err) - - ! Create another data space but for each proc individually - dims(1) = work - call h5screate_simple_f(1, 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) = work_index(rank) - 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) - - ! 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 - - ! Open dataset - call h5dopen_f(group_id, "source_bank", dset, hdf5_err) - - ! Set up pointer to data - f_ptr = c_loc(source_bank) - - ! 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 - - end subroutine read_source_bank - function using_mpio_device(obj_id) result(mpio) integer(HID_T), intent(in) :: obj_id logical :: mpio diff --git a/src/hdf5_summary.F90 b/src/hdf5_summary.F90 index a9dab46f5..e8f566c43 100644 --- a/src/hdf5_summary.F90 +++ b/src/hdf5_summary.F90 @@ -6,16 +6,16 @@ module hdf5_summary use geometry_header, only: Cell, Surface, Universe, Lattice, RectLattice, & &HexLattice 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 use tally_header, only: TallyObject - implicit none + use hdf5 - type(BinaryOutput) :: su + implicit none contains @@ -25,48 +25,48 @@ contains subroutine hdf5_write_summary() - character(MAX_FILE_LEN) :: filename = "summary.h5" + integer(HID_T) :: file_id ! Create a new file using default properties. - call su % file_create(filename) + file_id = file_create("summary.h5") ! Write header information - call hdf5_write_header() + call hdf5_write_header(file_id) ! Write eigenvalue information if (run_mode == MODE_EIGENVALUE) then ! Write number of particles - call su % write_data(n_particles, "n_particles") + call write_dataset(file_id, "n_particles", n_particles) ! Use H5LT interface to write n_batches, n_inactive, and n_active - call su % write_data(n_batches, "n_batches") - call su % write_data(n_inactive, "n_inactive") - call su % write_data(n_active, "n_active") - call su % write_data(gen_per_batch, "gen_per_batch") + call write_dataset(file_id, "n_batches", n_batches) + call write_dataset(file_id, "n_inactive", n_inactive) + call write_dataset(file_id, "n_active", n_active) + call write_dataset(file_id, "gen_per_batch", gen_per_batch) ! Add description of each variable - call su % write_attribute_string("n_particles", & + call write_attribute_string(file_id, "n_particles", & "description", "Number of particles per generation") - call su % write_attribute_string("n_batches", & + call write_attribute_string(file_id, "n_batches", & "description", "Total number of batches") - call su % write_attribute_string("n_inactive", & + call write_attribute_string(file_id, "n_inactive", & "description", "Number of inactive batches") - call su % write_attribute_string("n_active", & + call write_attribute_string(file_id, "n_active", & "description", "Number of active batches") - call su % write_attribute_string("gen_per_batch", & + call write_attribute_string(file_id, "gen_per_batch", & "description", "Number of generations per batch") end if - call hdf5_write_geometry() - call hdf5_write_materials() - call hdf5_write_nuclides() + call hdf5_write_geometry(file_id) + call hdf5_write_materials(file_id) + call hdf5_write_nuclides(file_id) if (n_tallies > 0) then - call hdf5_write_tallies() + call hdf5_write_tallies(file_id) end if ! Terminate access to the file. - call su % file_close() + call file_close(file_id) end subroutine hdf5_write_summary @@ -74,19 +74,20 @@ contains ! HDF5_WRITE_HEADER !=============================================================================== - subroutine hdf5_write_header() + subroutine hdf5_write_header(file_id) + integer(HID_T), intent(in) :: file_id ! Write version information - call su % write_data(VERSION_MAJOR, "version_major") - call su % write_data(VERSION_MINOR, "version_minor") - call su % write_data(VERSION_RELEASE, "version_release") + call write_dataset(file_id, "version_major", VERSION_MAJOR) + call write_dataset(file_id, "version_minor", VERSION_MINOR) + call write_dataset(file_id, "version_release", VERSION_RELEASE) ! Write current date and time - call su % write_data(time_stamp(), "date_and_time") + call write_dataset(file_id, "date_and_time", time_stamp()) ! Write MPI information - call su % write_data(n_procs, "n_procs") - call su % write_attribute_string("n_procs", "description", & + call write_dataset(file_id, "n_procs", n_procs) + call write_attribute_string(file_id, "n_procs", "description", & "Number of MPI processes") end subroutine hdf5_write_header @@ -95,782 +96,659 @@ contains ! HDF5_WRITE_GEOMETRY !=============================================================================== - subroutine hdf5_write_geometry() + subroutine hdf5_write_geometry(file_id) + integer(HID_T), intent(in) :: file_id integer :: i, j, k, m integer, allocatable :: lattice_universes(:,:,:) - type(Cell), pointer :: c => null() - type(Surface), pointer :: s => null() - type(Universe), pointer :: u => null() - class(Lattice), pointer :: lat => null() + integer(HID_T) :: geom_group + integer(HID_T) :: cells_group, cell_group + integer(HID_T) :: surfaces_group, surface_group + integer(HID_T) :: universes_group, univ_group + integer(HID_T) :: lattices_group, lattice_group + type(Cell), pointer :: c + type(Surface), pointer :: s + type(Universe), pointer :: u + class(Lattice), pointer :: lat ! Use H5LT interface to write number of geometry objects - call su % write_data(n_cells, "n_cells", group="geometry") - call su % write_data(n_surfaces, "n_surfaces", group="geometry") - call su % write_data(n_universes, "n_universes", group="geometry") - call su % write_data(n_lattices, "n_lattices", group="geometry") + geom_group = create_group(file_id, "geometry") + call write_dataset(geom_group, "n_cells", n_cells) + call write_dataset(geom_group, "n_surfaces", n_surfaces) + call write_dataset(geom_group, "n_universes", n_universes) + call write_dataset(geom_group, "n_lattices", n_lattices) ! ========================================================================== ! WRITE INFORMATION ON CELLS ! Create a cell group (nothing directly written in this group) then close - call su % open_group("geometry/cells") - call su % close_group() + cells_group = create_group(geom_group, "cells") ! Write information on each cell CELL_LOOP: do i = 1, n_cells c => cells(i) + cell_group = create_group(cells_group, "cell " // trim(to_str(c%id))) ! Write internal OpenMC index for this cell - call su % write_data(i, "index", & - group="geometry/cells/cell " // trim(to_str(c % id))) + call write_dataset(cell_group, "index", i) ! Write name for this cell - call su % write_data(c % name, "name", & - group="geometry/cells/cell " // trim(to_str(c % id))) + call write_dataset(cell_group, "name", c%name) ! Write universe for this cell - call su % write_data(universes(c % universe) % id, "universe", & - group="geometry/cells/cell " // trim(to_str(c % id))) + call write_dataset(cell_group, "universe", universes(c%universe)%id) ! Write information on what fills this cell - select case (c % type) + select case (c%type) case (CELL_NORMAL) - call su % write_data("normal", "fill_type", & - group="geometry/cells/cell " // trim(to_str(c % id))) - if (c % material == MATERIAL_VOID) then - call su % write_data(-1, "material", & - group="geometry/cells/cell " // trim(to_str(c % id))) + call write_dataset(cell_group, "fill_type", "normal") + if (c%material == MATERIAL_VOID) then + call write_dataset(cell_group, "material", -1) else - call su % write_data(materials(c % material) % id, "material", & - group="geometry/cells/cell " // trim(to_str(c % id))) + call write_dataset(cell_group, "material", materials(c%material)%id) end if case (CELL_FILL) - call su % write_data("universe", "fill_type", & - group="geometry/cells/cell " // trim(to_str(c % id))) - call su % write_data(universes(c % fill) % id, "fill", & - group="geometry/cells/cell " // trim(to_str(c % id))) - - call su % write_data(size(c % offset), "maps", & - group="geometry/cells/cell " // trim(to_str(c % id))) - if (size(c % offset) > 0) then - call su % write_data(c % offset, "offset", & - length=size(c % offset), & - group="geometry/cells/cell " // trim(to_str(c % id))) + call write_dataset(cell_group, "fill_type", "universe") + call write_dataset(cell_group, "fill", universes(c%fill)%id) + call write_dataset(cell_group, "maps", size(c%offset)) + if (size(c%offset) > 0) then + call write_dataset(cell_group, "offset", c%offset) end if - if (allocated(c % translation)) then - call su % write_data(1, "translated", & - group="geometry/cells/cell " // trim(to_str(c % id))) - call su % write_data(c % translation, "translation", length=3, & - group="geometry/cells/cell " // trim(to_str(c % id))) + if (allocated(c%translation)) then + call write_dataset(cell_group, "translated", 1) + call write_dataset(cell_group, "translation", c%translation) else - call su % write_data(0, "translated", & - group="geometry/cells/cell " // trim(to_str(c % id))) + call write_dataset(cell_group, "translated", 0) end if - if (allocated(c % rotation)) then - call su % write_data(1, "rotated", & - group="geometry/cells/cell " // trim(to_str(c % id))) - call su % write_data(c % rotation, "rotation", length=3, & - group="geometry/cells/cell " // trim(to_str(c % id))) + if (allocated(c%rotation)) then + call write_dataset(cell_group, "rotated", 1) + call write_dataset(cell_group, "rotation", c%rotation) else - call su % write_data(0, "rotated", & - group="geometry/cells/cell " // trim(to_str(c % id))) + call write_dataset(cell_group, "rotated", 0) end if case (CELL_LATTICE) - call su % write_data("lattice", "fill_type", & - group="geometry/cells/cell " // trim(to_str(c % id))) - call su % write_data(lattices(c % fill) % obj % id, "lattice", & - group="geometry/cells/cell " // trim(to_str(c % id))) + call write_dataset(cell_group, "fill_type", "lattice") + call write_dataset(cell_group, "lattice", lattices(c%fill)%obj%id) end select ! Write list of bounding surfaces - if (c % n_surfaces > 0) then - call su % write_data(c % surfaces, "surfaces", length= c % n_surfaces, & - group="geometry/cells/cell " // trim(to_str(c % id))) + if (c%n_surfaces > 0) then + call write_dataset(cell_group, "surfaces", c%surfaces) end if + call close_group(cell_group) end do CELL_LOOP + call close_group(cells_group) + ! ========================================================================== ! WRITE INFORMATION ON SURFACES - ! Create surfaces group (nothing directly written here) then close - call su % open_group("geometry/surfaces") - call su % close_group() + ! Create surfaces group + surfaces_group = create_group(file_id, "surfaces") ! Write information on each surface SURFACE_LOOP: do i = 1, n_surfaces s => surfaces(i) + surface_group = create_group(surfaces_group, "surface " // & + trim(to_str(s%id))) ! Write internal OpenMC index for this surface - call su % write_data(i, "index", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "index", i) ! Write name for this surface - call su % write_data(s % name, "name", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "name", s%name) ! Write surface type - select case (s % type) + select case (s%type) case (SURF_PX) - call su % write_data("X Plane", "type", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "type", "X Plane") case (SURF_PY) - call su % write_data("Y Plane", "type", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "type", "Y Plane") case (SURF_PZ) - call su % write_data("Z Plane", "type", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "type", "Z Plane") case (SURF_PLANE) - call su % write_data("Plane", "type", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "type", "Plane") case (SURF_CYL_X) - call su % write_data("X Cylinder", "type", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "type", "X Cylinder") case (SURF_CYL_Y) - call su % write_data("Y Cylinder", "type", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "type", "Y Cylinder") case (SURF_CYL_Z) - call su % write_data("Z Cylinder", "type", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "type", "Z Cylinder") case (SURF_SPHERE) - call su % write_data("Sphere", "type", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "type", "Sphere") case (SURF_CONE_X) - call su % write_data("X Cone", "type", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "type", "X Cone") case (SURF_CONE_Y) - call su % write_data("Y Cone", "type", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "type", "Y Cone") case (SURF_CONE_Z) - call su % write_data("Z Cone", "type", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "type", "Z Cone") end select ! Write coefficients for surface - call su % write_data(s % coeffs, "coefficients", length=size(s % coeffs), & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "coefficients", s%coeffs) ! Write positive neighbors - if (allocated(s % neighbor_pos)) then - call su % write_data(s % neighbor_pos, "neighbors_positive", & - length=size(s % neighbor_pos), & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + if (allocated(s%neighbor_pos)) then + call write_dataset(surface_group, "neighbors_positive", s%neighbor_pos) end if ! Write negative neighbors - if (allocated(s % neighbor_neg)) then - call su % write_data(s % neighbor_neg, "neighbors_negative", & - length=size(s % neighbor_neg), & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + if (allocated(s%neighbor_neg)) then + call write_dataset(surface_group, "neighbors_negative", s%neighbor_neg) end if ! Write boundary condition - select case (s % bc) + select case (s%bc) case (BC_TRANSMIT) - call su % write_data("transmission", "boundary_condition", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "boundary_condition", "transmission") case (BC_VACUUM) - call su % write_data("vacuum", "boundary_condition", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "boundary_condition", "vacuum") case (BC_REFLECT) - call su % write_data("reflective", "boundary_condition", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "boundary_condition", "reflective") case (BC_PERIODIC) - call su % write_data("periodic", "boundary_condition", & - group="geometry/surfaces/surface " // trim(to_str(s % id))) + call write_dataset(surface_group, "boundary_condition", "periodic") end select + call close_group(surface_group) end do SURFACE_LOOP + call close_group(surfaces_group) + ! ========================================================================== ! WRITE INFORMATION ON UNIVERSES ! Create universes group (nothing directly written here) then close - call su % open_group("geometry/universes") - call su % close_group() + universes_group = create_group(geom_group, "universes") ! Write information on each universe UNIVERSE_LOOP: do i = 1, n_universes u => universes(i) + univ_group = create_group(universes_group, "universe " // & + trim(to_str(u%id))) ! Write internal OpenMC index for this universe - call su % write_data(i, "index", & - group="geometry/universes/universe " // trim(to_str(u % id))) + call write_dataset(univ_group, "index", i) ! Write list of cells in this universe - if (u % n_cells > 0) then - call su % write_data(u % cells, "cells", length=u % n_cells, & - group="geometry/universes/universe " // trim(to_str(u % id))) - end if + if (u%n_cells > 0) call write_dataset(univ_group, "cells", u%cells) + call close_group(univ_group) end do UNIVERSE_LOOP + call close_group(universes_group) + ! ========================================================================== ! WRITE INFORMATION ON LATTICES ! Create lattices group (nothing directly written here) then close - call su % open_group("geometry/lattices") - call su % close_group() + lattices_group = create_group(geom_group, "lattices") ! Write information on each lattice LATTICE_LOOP: do i = 1, n_lattices - lat => lattices(i) % obj + lat => lattices(i)%obj + lattice_group = create_group(lattices_group, "lattice " // trim(to_str(lat%id))) ! Write internal OpenMC index for this lattice - call su % write_data(i, "index", & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) + call write_dataset(lattice_group, "index", i) ! Write name for this lattice - call su % write_data(lat % name, "name", & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) + call write_dataset(lattice_group, "name", lat%name) ! Write lattice type select type (lat) type is (RectLattice) ! Write lattice type. - call su % write_data("rectangular", "type", & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) + call write_dataset(lattice_group, "type", "rectangular") ! Write lattice dimensions, lower left corner, and pitch - call su % write_data(lat % n_cells, "dimension", length=3, & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) + call write_dataset(lattice_group, "dimension", lat%n_cells) + call write_dataset(lattice_group, "lower_left", lat%lower_left) + call write_dataset(lattice_group, "pitch", lat%pitch) - if (lat % is_3d) then - call su % write_data(lat % lower_left, "lower_left", length=3, & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - else - call su % write_data(lat % lower_left, "lower_left", length=2, & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - end if + call write_dataset(lattice_group, "outer", lat%outer) + call write_dataset(lattice_group, "offset_size", size(lat%offset)) + call write_dataset(lattice_group, "maps", size(lat%offset,1)) - if (lat % is_3d) then - call su % write_data(lat % pitch, "pitch", length=3, & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - else - call su % write_data(lat % pitch, "pitch", length=2, & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - end if - - call su % write_data(lat % outer, "outer", & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - call su % write_data(size(lat % offset), "offset_size", & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - call su % write_data(size(lat % offset,1), "maps", & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - - if (size(lat % offset) > 0) then - call su % write_data(lat % offset, "offsets", & - length=shape(lat % offset), & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) + if (size(lat%offset) > 0) then + call write_dataset(lattice_group, "offsets", lat%offset) end if ! Write lattice universes. - allocate(lattice_universes(lat % n_cells(1), lat % n_cells(2), & - &lat % n_cells(3))) - do j = 1, lat % n_cells(1) - do k = 1, lat % n_cells(2) - do m = 1, lat % n_cells(3) - lattice_universes(j,k,m) = universes(lat % universes(j,k,m)) % id + allocate(lattice_universes(lat%n_cells(1), lat%n_cells(2), & + &lat%n_cells(3))) + do j = 1, lat%n_cells(1) + do k = 1, lat%n_cells(2) + do m = 1, lat%n_cells(3) + lattice_universes(j,k,m) = universes(lat%universes(j,k,m))%id end do end do end do - call su % write_data(lattice_universes, "universes", & - length=lat % n_cells, & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) + call write_dataset(lattice_group, "universes", lattice_universes) deallocate(lattice_universes) type is (HexLattice) ! Write lattice type. - call su % write_data("hexagonal", "type", & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) + call write_dataset(lattice_group, "type", "hexagonal") ! Write number of lattice cells. - call su % write_data(lat % n_rings, "n_rings", & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - call su % write_data(lat % n_axial, "n_axial", & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) + call write_dataset(lattice_group, "n_rings", lat%n_rings) + call write_dataset(lattice_group, "n_axial", lat%n_axial) ! Write lattice center, pitch and outer universe. - if (lat % is_3d) then - call su % write_data(lat % center, "center", length=3, & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - else - call su % write_data(lat % center, "center", length=2, & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - end if + call write_dataset(lattice_group, "center", lat%center) + call write_dataset(lattice_group, "pitch", lat%pitch) - if (lat % is_3d) then - call su % write_data(lat % pitch, "pitch", length=2, & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - else - call su % write_data(lat % pitch, "pitch", length=1, & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - end if + call write_dataset(lattice_group, "outer", lat%outer) + call write_dataset(lattice_group, "offset_size", size(lat%offset)) + call write_dataset(lattice_group, "maps", size(lat%offset,1)) - call su % write_data(lat % outer, "outer", & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - call su % write_data(size(lat % offset), "offset_size", & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - call su % write_data(size(lat % offset,1), "maps", & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) - - if (size(lat % offset) > 0) then - call su % write_data(lat % offset, "offsets", & - length=shape(lat % offset), & - group="geometry/lattices/lattice " // trim(to_str(lat % id))) + if (size(lat%offset) > 0) then + call write_dataset(lattice_group, "offsets", lat%offset) end if ! Write lattice universes. - allocate(lattice_universes(2*lat % n_rings - 1, 2*lat % n_rings - 1, & - &lat % n_axial)) - do m = 1, lat % n_axial - do k = 1, 2*lat % n_rings - 1 - do j = 1, 2*lat % n_rings - 1 - if (j + k < lat % n_rings + 1) then + allocate(lattice_universes(2*lat%n_rings - 1, 2*lat%n_rings - 1, & + &lat%n_axial)) + do m = 1, lat%n_axial + do k = 1, 2*lat%n_rings - 1 + do j = 1, 2*lat%n_rings - 1 + if (j + k < lat%n_rings + 1) then ! This array position is never used; put a -1 to indicate this lattice_universes(j,k,m) = -1 cycle - else if (j + k > 3*lat % n_rings - 1) then + else if (j + k > 3*lat%n_rings - 1) then ! This array position is never used; put a -1 to indicate this lattice_universes(j,k,m) = -1 cycle end if - lattice_universes(j,k,m) = universes(lat % universes(j,k,m)) % id + lattice_universes(j,k,m) = universes(lat%universes(j,k,m))%id end do end do end do - call su % write_data(lattice_universes, "universes", & - &length=(/2*lat % n_rings-1, 2*lat % n_rings-1, lat % n_axial/), & - &group="geometry/lattices/lattice " // trim(to_str(lat % id))) + call write_dataset(lattice_group, "universes", lattice_universes) deallocate(lattice_universes) end select + + call close_group(lattice_group) end do LATTICE_LOOP + call close_group(lattices_group) + call close_group(geom_group) + end subroutine hdf5_write_geometry !=============================================================================== ! HDF5_WRITE_MATERIALS !=============================================================================== - subroutine hdf5_write_materials() + subroutine hdf5_write_materials(file_id) + integer(HID_T), intent(in) :: file_id integer :: i integer :: j integer, allocatable :: zaids(:) - type(Material), pointer :: m => null() + integer(HID_T) :: materials_group + integer(HID_T) :: material_group + integer(HID_T) :: sab_group + type(Material), pointer :: m - ! Use H5LT interface to write number of materials - call su % write_data(n_materials, "n_materials", group="materials") + materials_group = create_group(file_id, "materials") + + ! write number of materials + call write_dataset(file_id, "n_materials", n_materials) ! Write information on each material do i = 1, n_materials m => materials(i) + material_group = create_group(materials_group, "material " // & + trim(to_str(m%id))) ! Write internal OpenMC index for this material - call su % write_data(i, "index", & - group="materials/material " // trim(to_str(m % id))) + call write_dataset(material_group, "index", i) ! Write name for this material - call su % write_data(m % name, "name", & - group="materials/material " // trim(to_str(m % id))) + call write_dataset(material_group, "name", m%name) ! Write atom density with units - call su % write_data(m % density, "atom_density", & - group="materials/material " // trim(to_str(m % id))) - call su % write_attribute_string("atom_density", "units", "atom/b-cm", & - group="materials/material " // trim(to_str(m % id))) + call write_dataset(material_group, "atom_density", m%density) + call write_attribute_string(material_group, "atom_density", "units", & + "atom/b-cm") ! 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 + 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' - call su % write_data(zaids, "nuclides", length=m % n_nuclides, & - group="materials/material " // trim(to_str(m % id))) + call write_dataset(material_group, "nuclides", zaids) ! Deallocate temporary array deallocate(zaids) ! Write atom densities - call su % write_data(m % atom_density, "nuclide_densities", & - length=m % n_nuclides, & - group="materials/material " // trim(to_str(m % id))) + call write_dataset(material_group, "nuclide_densities", m%atom_density) ! Write S(a,b) information if present - call su % write_data(m % n_sab, "n_sab", & - group="materials/material " // trim(to_str(m % id))) + call write_dataset(material_group, "n_sab", m%n_sab) - if (m % n_sab > 0) then - call su % write_data(m % i_sab_nuclides, "i_sab_nuclides", & - length=m % n_sab, & - group="materials/material " // trim(to_str(m % id))) - call su % write_data(m % i_sab_tables, "i_sab_tables", & - length=m % n_sab, & - group="materials/material " // trim(to_str(m % id))) + if (m%n_sab > 0) then + call write_dataset(material_group, "i_sab_nuclides", m%i_sab_nuclides) + call write_dataset(material_group, "i_sab_tables", m%i_sab_tables) - do j = 1, m % n_sab - call su % write_data(m % sab_names(j), to_str(j), & - group="materials/material " // & - trim(to_str(m % id)) // "/sab_tables") + sab_group = create_group(material_group, "sab_tables") + do j = 1, m%n_sab + call write_dataset(sab_group, to_str(j), m%sab_names(j)) end do + call close_group(sab_group) end if + call close_group(material_group) end do + call close_group(materials_group) + end subroutine hdf5_write_materials !=============================================================================== ! HDF5_WRITE_TALLIES !=============================================================================== - subroutine hdf5_write_tallies() + subroutine hdf5_write_tallies(file_id) + integer(HID_T), intent(in) :: file_id integer :: i, j integer, allocatable :: temp_array(:) ! nuclide bin array - type(StructuredMesh), pointer :: m => null() - type(TallyObject), pointer :: t => null() + integer(HID_T) :: tallies_group + integer(HID_T) :: mesh_group + integer(HID_T) :: tally_group + integer(HID_T) :: filter_group + type(StructuredMesh), pointer :: m + type(TallyObject), pointer :: t + + tallies_group = create_group(file_id, "tallies") ! Write total number of meshes - call su % write_data(n_meshes, "n_meshes", group="tallies") + call write_dataset(tallies_group, "n_meshes", n_meshes) ! Write information for meshes MESH_LOOP: do i = 1, n_meshes m => meshes(i) + mesh_group = create_group(tallies_group, "mesh " // trim(to_str(m%id))) ! Write type and number of dimensions - call su % write_data(m % type, "type", & - group="tallies/mesh " // trim(to_str(m % id))) - - call su % write_data(m % n_dimension, "n_dimension", & - group="tallies/mesh " // trim(to_str(m % id))) + call write_dataset(mesh_group, "type", m%type) + call write_dataset(mesh_group, "n_dimension", m%n_dimension) ! Write mesh information - call su % write_data(m % dimension, "dimension", & - length=m % n_dimension, & - group="tallies/mesh " // trim(to_str(m % id))) - call su % write_data(m % lower_left, "lower_left", & - length=m % n_dimension, & - group="tallies/mesh " // trim(to_str(m % id))) - call su % write_data(m % upper_right, "upper_right", & - length=m % n_dimension, & - group="tallies/mesh " // trim(to_str(m % id))) - call su % write_data(m % width, "width", & - length=m % n_dimension, & - group="tallies/mesh " // trim(to_str(m % id))) + call write_dataset(mesh_group, "dimension", m%dimension) + call write_dataset(mesh_group, "lower_left", m%lower_left) + call write_dataset(mesh_group, "upper_right", m%upper_right) + call write_dataset(mesh_group, "width", m%width) + call close_group(mesh_group) end do MESH_LOOP ! Write number of tallies - call su % write_data(n_tallies, "n_tallies", group="tallies") + call write_dataset(tallies_group, "n_tallies", n_tallies) TALLY_METADATA: do i = 1, n_tallies ! Get pointer to tally t => tallies(i) + tally_group = create_group(tallies_group, "tally " // trim(to_str(t%id))) ! Write the name for this tally - call su % write_data(len(t % name), "name_size", & - group="tallies/tally " // trim(to_str(t % id))) - if (len(t % name) > 0) then - call su % write_data(t % name, "name", & - group="tallies/tally " // trim(to_str(t % id))) + call write_dataset(tally_group, "name_size", len(t%name)) + if (len(t%name) > 0) then + call write_dataset(tally_group, "name", t%name) endif ! Write size of each tally - call su % write_data(t % total_score_bins, "total_score_bins", & - group="tallies/tally " // trim(to_str(t % id))) - call su % write_data(t % total_filter_bins, "total_filter_bins", & - group="tallies/tally " // trim(to_str(t % id))) + call write_dataset(tally_group, "total_score_bins", t%total_score_bins) + call write_dataset(tally_group, "total_filter_bins", t%total_filter_bins) ! Write number of filters - call su % write_data(t % n_filters, "n_filters", & - group="tallies/tally " // trim(to_str(t % id))) + call write_dataset(tally_group, "n_filters", t%n_filters) + + FILTER_LOOP: do j = 1, t%n_filters + filter_group = create_group(tally_group, "filter " // trim(to_str(j))) - FILTER_LOOP: do j = 1, t % n_filters ! Write type of filter - call su % write_data(t % filters(j) % type, "type", & - group="tallies/tally " // trim(to_str(t % id)) & - // "/filter " // trim(to_str(j))) + call write_dataset(filter_group, "type", t%filters(j)%type) ! Write number of bins for this filter - call su % write_data(t % filters(j) % n_bins, "n_bins", & - group="tallies/tally " // trim(to_str(t % id)) & - // "/filter " // trim(to_str(j))) + call write_dataset(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 - call su % write_data(t % filters(j) % real_bins, "bins", & - length=size(t % filters(j) % real_bins), & - group="tallies/tally " // trim(to_str(t % id)) & - // "/filter " // trim(to_str(j))) + if (t%filters(j)%type == FILTER_ENERGYIN .or. & + t%filters(j)%type == FILTER_ENERGYOUT) then + call write_dataset(filter_group, "bins", t%filters(j)%real_bins) else - call su % write_data(t % filters(j) % int_bins, "bins", & - length=size(t % filters(j) % int_bins), & - group="tallies/tally " // trim(to_str(t % id)) & - // "/filter " // trim(to_str(j))) + call write_dataset(filter_group, "bins", t%filters(j)%int_bins) end if ! Write name of type - select case (t % filters(j) % type) + select case (t%filters(j)%type) case(FILTER_UNIVERSE) - call su % write_data("universe", "type_name", & - group="tallies/tally " // trim(to_str(t % id)) & - // "/filter " // trim(to_str(j))) + call write_dataset(filter_group, "type_name", "universe") case(FILTER_MATERIAL) - call su % write_data("material", "type_name", & - group="tallies/tally " // trim(to_str(t % id)) & - // "/filter " // trim(to_str(j))) + call write_dataset(filter_group, "type_name", "material") case(FILTER_CELL) - call su % write_data("cell", "type_name", & - group="tallies/tally " // trim(to_str(t % id)) & - // "/filter " // trim(to_str(j))) + call write_dataset(filter_group, "type_name", "cell") case(FILTER_CELLBORN) - call su % write_data("cellborn", "type_name", & - group="tallies/tally " // trim(to_str(t % id)) & - // "/filter " // trim(to_str(j))) + call write_dataset(filter_group, "type_name", "cellborn") case(FILTER_SURFACE) - call su % write_data("surface", "type_name", & - group="tallies/tally " // trim(to_str(t % id)) & - // "/filter " // trim(to_str(j))) + call write_dataset(filter_group, "type_name", "surface") case(FILTER_MESH) - call su % write_data("mesh", "type_name", & - group="tallies/tally " // trim(to_str(t % id)) & - // "/filter " // trim(to_str(j))) + call write_dataset(filter_group, "type_name", "mesh") case(FILTER_ENERGYIN) - call su % write_data("energy", "type_name", & - group="tallies/tally " // trim(to_str(t % id)) & - // "/filter " // trim(to_str(j))) + call write_dataset(filter_group, "type_name", "energy") case(FILTER_ENERGYOUT) - call su % write_data("energyout", "type_name", & - group="tallies/tally " // trim(to_str(t % id)) & - // "/filter " // trim(to_str(j))) + call write_dataset(filter_group, "type_name", "energyout") end select + call close_group(filter_group) end do FILTER_LOOP ! Write number of nuclide bins - call su % write_data(t % n_nuclide_bins, "n_nuclide_bins", & - group="tallies/tally " // trim(to_str(t % id))) + call write_dataset(tally_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 + 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) + temp_array(j) = t%nuclide_bins(j) end if end do NUCLIDE_LOOP ! Write and deallocate nuclide bins - call su % write_data(temp_array, "nuclide_bins", length=t % n_nuclide_bins, & - group="tallies/tally " // trim(to_str(t % id))) + call write_dataset(tally_group, "nuclide_bins", temp_array) deallocate(temp_array) ! Write number of score bins - call su % write_data(t % n_score_bins, "n_score_bins", & - group="tallies/tally " // trim(to_str(t % id))) - call su % write_data(t % score_bins, "score_bins", length=t % n_score_bins, & - group="tallies/tally " // trim(to_str(t % id))) + call write_dataset(tally_group, "n_score_bins", t%n_score_bins) + call write_dataset(tally_group, "score_bins", t%score_bins) + call close_group(tally_group) end do TALLY_METADATA + call close_group(tallies_group) + end subroutine hdf5_write_tallies !=============================================================================== ! HDF5_WRITE_NUCLIDES !=============================================================================== - subroutine hdf5_write_nuclides() + subroutine hdf5_write_nuclides(file_id) + integer(HID_T), intent(in) :: file_id integer :: i, j integer :: size_total integer :: size_xs integer :: size_angle integer :: size_energy - type(Nuclide), pointer :: nuc => null() - type(Reaction), pointer :: rxn => null() - type(UrrData), pointer :: urr => null() + integer(HID_T) :: nuclides_group, nuclide_group + integer(HID_T) :: reactions_group, rxn_group + type(Nuclide), pointer :: nuc + type(Reaction), pointer :: rxn + type(UrrData), pointer :: urr - ! Use H5LT interface to write number of nuclides - call su % write_data(n_nuclides_total, "n_nuclides", group="nuclides") + nuclides_group = create_group(file_id, "nuclides") + + ! write number of nuclides + call write_dataset(nuclides_group, "n_nuclides", n_nuclides_total) ! Write information on each nuclide NUCLIDE_LOOP: do i = 1, n_nuclides_total nuc => nuclides(i) + nuclide_group = create_group(nuclides_group, nuc%name) ! Write internal OpenMC index for this nuclide - call su % write_data(i, "index", & - group="nuclides/" // trim(nuc % name)) + call write_dataset(nuclide_group, "index", i) ! Determine size of cross-sections - size_xs = (5 + nuc % n_reaction) * nuc % n_grid * 8 + size_xs = (5 + nuc%n_reaction) * nuc%n_grid * 8 size_total = size_xs ! Write some basic attributes - call su % write_data(nuc % zaid, "zaid", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(xs_listings(nuc % listing) % alias, "alias", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(nuc % awr, "awr", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(nuc % kT, "kT", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(nuc % n_grid, "n_grid", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(nuc % n_reaction, "n_reactions", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(nuc % n_fission, "n_fission", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(size_xs, "size_xs", & - group="nuclides/" // trim(nuc % name)) + call write_dataset(nuclide_group, "zaid", nuc%zaid) + call write_dataset(nuclide_group, "alias", xs_listings(nuc%listing)%alias) + call write_dataset(nuclide_group, "awr", nuc%awr) + call write_dataset(nuclide_group, "kT", nuc%kT) + call write_dataset(nuclide_group, "n_grid", nuc%n_grid) + call write_dataset(nuclide_group, "n_reactions", nuc%n_reaction) + call write_dataset(nuclide_group, "n_fission", nuc%n_fission) + call write_dataset(nuclide_group, "size_xs", size_xs) ! ======================================================================= ! WRITE INFORMATION ON EACH REACTION ! Create overall group for reactions and close it - call su % open_group("nuclides/" // trim(nuc % name) // "/reactions") - call su % close_group() + reactions_group = create_group(nuclide_group, "reactions") - RXN_LOOP: do j = 1, nuc % n_reaction + RXN_LOOP: do j = 1, nuc%n_reaction ! Information on each reaction - rxn => nuc % reactions(j) + rxn => nuc%reactions(j) + rxn_group = create_group(reactions_group, trim(reaction_name(rxn%MT))) ! Determine size of angle distribution - if (rxn % has_angle_dist) then - size_angle = rxn % adist % n_energy * 16 + size(rxn % adist % data) * 8 + 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 + if (rxn%has_energy_dist) then + size_energy = size(rxn%edist%data) * 8 else size_energy = 0 end if ! Write information on reaction - call su % write_data(rxn % Q_value, "Q_value", & - group="nuclides/" // trim(nuc % name) // "/reactions/" // & - trim(reaction_name(rxn % MT))) - call su % write_data(rxn % multiplicity, "multiplicity", & - group="nuclides/" // trim(nuc % name) // "/reactions/" // & - trim(reaction_name(rxn % MT))) - call su % write_data(rxn % threshold, "threshold", & - group="nuclides/" // trim(nuc % name) // "/reactions/" // & - trim(reaction_name(rxn % MT))) - call su % write_data(size_angle, "size_angle", & - group="nuclides/" // trim(nuc % name) // "/reactions/" // & - trim(reaction_name(rxn % MT))) - call su % write_data(size_energy, "size_energy", & - group="nuclides/" // trim(nuc % name) // "/reactions/" // & - trim(reaction_name(rxn % MT))) + call write_dataset(rxn_group, "Q_value", rxn%Q_value) + call write_dataset(rxn_group, "multiplicity", rxn%multiplicity) + call write_dataset(rxn_group, "threshold", rxn%threshold) + call write_dataset(rxn_group, "size_angle", size_angle) + call write_dataset(rxn_group, "size_energy", size_energy) ! Accumulate data size size_total = size_total + size_angle + size_energy + + call close_group(rxn_group) end do RXN_LOOP + call close_group(reactions_group) + ! ======================================================================= ! WRITE INFORMATION ON URR PROBABILITY TABLES - if (nuc % urr_present) then - urr => nuc % urr_data - call su % write_data(urr % n_energy, "urr_n_energy", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(urr % n_prob, "urr_n_prob", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(urr % interp, "urr_interp", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(urr % inelastic_flag, "urr_inelastic", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(urr % absorption_flag, "urr_absorption", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(urr % energy(1), "urr_min_E", & - group="nuclides/" // trim(nuc % name)) - call su % write_data(urr % energy(urr % n_energy), "urr_max_E", & - group="nuclides/" // trim(nuc % name)) + if (nuc%urr_present) then + urr => nuc%urr_data + call write_dataset(nuclide_group, "urr_n_energy", urr%n_energy) + call write_dataset(nuclide_group, "urr_n_prob", urr%n_prob) + call write_dataset(nuclide_group, "urr_interp", urr%interp) + call write_dataset(nuclide_group, "urr_inelastic", urr%inelastic_flag) + call write_dataset(nuclide_group, "urr_absorption", urr%absorption_flag) + call write_dataset(nuclide_group, "urr_min_E", urr%energy(1)) + call write_dataset(nuclide_group, "urr_max_E", urr%energy(urr%n_energy)) end if ! Write total memory used - call su % write_data(size_total, "size_total", & - group="nuclides/" // trim(nuc % name)) + call write_dataset(nuclide_group, "size_total", size_total) + call close_group(nuclide_group) end do NUCLIDE_LOOP + call close_group(nuclides_group) + end subroutine hdf5_write_nuclides !=============================================================================== ! HDF5_WRITE_TIMING !=============================================================================== - subroutine hdf5_write_timing() + subroutine hdf5_write_timing(file_id) + integer(HID_T), intent(in) :: file_id - integer(8) :: total_particles - real(8) :: speed + integer(8) :: total_particles + integer(HID_T) :: time_group + real(8) :: speed + + time_group = create_group(file_id, "timing") ! Write timing data - call su % write_data(time_initialize % elapsed, "time_initialize", & - group="timing") - call su % write_data(time_read_xs % elapsed, "time_read_xs", & - group="timing") - call su % write_data(time_transport % elapsed, "time_transport", & - group="timing") - call su % write_data(time_bank % elapsed, "time_bank", & - group="timing") - call su % write_data(time_bank_sample % elapsed, "time_bank_sample", & - group="timing") - call su % write_data(time_bank_sendrecv % elapsed, "time_bank_sendrecv", & - group="timing") - call su % write_data(time_tallies % elapsed, "time_tallies", & - group="timing") - call su % write_data(time_inactive % elapsed, "time_inactive", & - group="timing") - call su % write_data(time_active % elapsed, "time_active", & - group="timing") - call su % write_data(time_finalize % elapsed, "time_finalize", & - group="timing") - call su % write_data(time_total % elapsed, "time_total", & - group="timing") + call write_dataset(time_group, "time_initialize", time_initialize%elapsed) + call write_dataset(time_group, "time_read_xs", time_read_xs%elapsed) + call write_dataset(time_group, "time_transport", time_transport%elapsed) + call write_dataset(time_group, "time_bank", time_bank%elapsed) + call write_dataset(time_group, "time_bank_sample", time_bank_sample%elapsed) + call write_dataset(time_group, "time_bank_sendrecv", time_bank_sendrecv%elapsed) + call write_dataset(time_group, "time_tallies", time_tallies%elapsed) + call write_dataset(time_group, "time_inactive", time_inactive%elapsed) + call write_dataset(time_group, "time_active", time_active%elapsed) + call write_dataset(time_group, "time_finalize", time_finalize%elapsed) + call write_dataset(time_group, "time_total", time_total%elapsed) ! Add descriptions to timing data - call su % write_attribute_string("time_initialize", "description", & - "Total time elapsed for initialization (s)", group="timing") - call su % write_attribute_string("time_read_xs", "description", & - "Time reading cross-section libraries (s)", group="timing") - call su % write_attribute_string("time_transport", "description", & - "Time in transport only (s)", group="timing") - call su % write_attribute_string("time_bank", "description", & - "Total time synchronizing fission bank (s)", group="timing") - call su % write_attribute_string("time_bank_sample", "description", & - "Time between generations sampling source sites (s)", group="timing") - call su % write_attribute_string("time_bank_sendrecv", "description", & - "Time between generations SEND/RECVing source sites (s)", & - group="timing") - call su % write_attribute_string("time_tallies", "description", & - "Time between batches accumulating tallies (s)", group="timing") - call su % write_attribute_string("time_inactive", "description", & - "Total time in inactive batches (s)", group="timing") - call su % write_attribute_string("time_active", "description", & - "Total time in active batches (s)", group="timing") - call su % write_attribute_string("time_finalize", "description", & - "Total time for finalization (s)", group="timing") - call su % write_attribute_string("time_total", "description", & - "Total time elapsed (s)", group="timing") + call write_attribute_string(time_group, "time_initialize", "description", & + "Total time elapsed for initialization (s)") + call write_attribute_string(time_group, "time_read_xs", "description", & + "Time reading cross-section libraries (s)") + call write_attribute_string(time_group, "time_transport", "description", & + "Time in transport only (s)") + call write_attribute_string(time_group, "time_bank", "description", & + "Total time synchronizing fission bank (s)") + call write_attribute_string(time_group, "time_bank_sample", "description", & + "Time between generations sampling source sites (s)") + call write_attribute_string(time_group, "time_bank_sendrecv", "description", & + "Time between generations SEND/RECVing source sites (s)") + call write_attribute_string(time_group, "time_tallies", "description", & + "Time between batches accumulating tallies (s)") + call write_attribute_string(time_group, "time_inactive", "description", & + "Total time in inactive batches (s)") + call write_attribute_string(time_group, "time_active", "description", & + "Total time in active batches (s)") + call write_attribute_string(time_group, "time_finalize", "description", & + "Total time for finalization (s)") + call write_attribute_string(time_group, "time_total", "description", & + "Total time elapsed (s)") ! Write calculation rate total_particles = n_particles * n_batches * gen_per_batch - speed = real(total_particles) / (time_inactive % elapsed + & - time_active % elapsed) - call su % write_data(speed, "neutrons_per_second", group="timing") + speed = real(total_particles) / (time_inactive%elapsed + & + time_active%elapsed) + call write_dataset(time_group, "neutrons_per_second", speed) + call close_group(time_group) end subroutine hdf5_write_timing end module hdf5_summary diff --git a/src/initialize.F90 b/src/initialize.F90 index 22521b24d..29e5f8921 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -12,12 +12,14 @@ module initialize use geometry_header, only: Cell, Universe, Lattice, RectLattice, HexLattice,& &BASE_UNIVERSE use global + use hdf5_interface, only: file_open, read_dataset, file_close, hdf5_bank_t,& + hdf5_tallyresult_t, hdf5_integer8_t + use hdf5_summary, only: hdf5_write_summary use input_xml, only: read_input_xml, read_cross_sections_xml, & cells_in_univ_dict, read_plots_xml use material_header, only: Material use output, only: title, header, print_version, write_message, & print_usage, write_xs_summary, print_plot - use output_interface use random_lcg, only: initialize_prng use state_point, only: load_state_point use string, only: to_str, str_to_int, starts_with, ends_with @@ -32,8 +34,7 @@ module initialize use omp_lib #endif - use hdf5_interface - use hdf5_summary, only: hdf5_write_summary + use hdf5 implicit none @@ -49,8 +50,8 @@ contains subroutine initialize_run() ! Start total and initialization timer - call time_total % start() - call time_initialize % start() + call time_total%start() + call time_initialize%start() #ifdef MPI ! Setup MPI @@ -110,9 +111,9 @@ contains call normalize_ao() ! Read ACE-format cross sections - call time_read_xs % start() + call time_read_xs%start() call read_xs() - call time_read_xs % stop() + call time_read_xs%stop() ! Create linked lists for multiple instances of the same nuclide call same_nuclide_list() @@ -122,9 +123,9 @@ contains case (GRID_NUCLIDE) continue case (GRID_MAT_UNION) - call time_unionize % start() + call time_unionize%start() call unionized_grid() - call time_unionize % stop() + call time_unionize%stop() case (GRID_LOGARITHM) call logarithmic_grid() end select @@ -167,7 +168,7 @@ contains end if ! Stop initialization timer - call time_initialize % stop() + call time_initialize%stop() end subroutine initialize_run @@ -220,10 +221,10 @@ contains ! CREATE MPI_BANK TYPE ! Determine displacements for MPI_BANK type - call MPI_GET_ADDRESS(b % wgt, bank_disp(1), mpi_err) - call MPI_GET_ADDRESS(b % xyz, bank_disp(2), mpi_err) - call MPI_GET_ADDRESS(b % uvw, bank_disp(3), mpi_err) - call MPI_GET_ADDRESS(b % E, bank_disp(4), mpi_err) + call MPI_GET_ADDRESS(b%wgt, bank_disp(1), mpi_err) + call MPI_GET_ADDRESS(b%xyz, bank_disp(2), mpi_err) + call MPI_GET_ADDRESS(b%uvw, bank_disp(3), mpi_err) + call MPI_GET_ADDRESS(b%E, bank_disp(4), mpi_err) ! Adjust displacements bank_disp = bank_disp - bank_disp(1) @@ -239,8 +240,8 @@ contains ! CREATE MPI_TALLYRESULT TYPE ! Determine displacements for MPI_BANK type - call MPI_GET_ADDRESS(tr % value, result_base_disp, mpi_err) - call MPI_GET_ADDRESS(tr % sum, result_disp(1), mpi_err) + call MPI_GET_ADDRESS(tr%value, result_base_disp, mpi_err) + call MPI_GET_ADDRESS(tr%sum, result_disp(1), mpi_err) ! Adjust displacements result_disp = result_disp - result_base_disp @@ -274,6 +275,7 @@ contains type(TallyResult), target :: tmp(2) ! temporary TallyResult type(Bank), target :: tmpb(2) ! temporary Bank + integer :: hdf5_err integer(HID_T) :: coordinates_t ! HDF5 type for 3 reals integer(HSIZE_T) :: dims(1) = (/3/) ! size of coordinates @@ -318,8 +320,8 @@ contains integer :: argc ! number of command line arguments integer :: last_flag ! index of last flag integer :: filetype + integer(HID_T) :: file_id character(MAX_WORD_LEN), allocatable :: argv(:) ! command line arguments - type(BinaryOutput) :: sp ! Check number of command line arguments and allocate argv argc = COMMAND_ARGUMENT_COUNT() @@ -356,9 +358,9 @@ contains i = i + 1 ! Check what type of file this is - call sp % file_open(argv(i), 'r', serial = .false.) - call sp % read_data(filetype, 'filetype') - call sp % file_close() + file_id = file_open(argv(i), 'r', parallel=.true.) + call read_dataset(file_id, 'filetype', filetype) + call file_close(file_id) ! Set path and flag for type of run select case (filetype) @@ -379,13 +381,12 @@ contains i = i + 1 ! Check if it has extension we can read - if ((ends_with(argv(i), '.binary') .or. & - ends_with(argv(i), '.h5'))) then + if (ends_with(argv(i), '.h5')) then ! Check file type is a source file - call sp % file_open(argv(i), 'r', serial = .false.) - call sp % read_data(filetype, 'filetype') - call sp % file_close() + file_id = file_open(argv(i), 'r', parallel=.true.) + call read_dataset(file_id, 'filetype', filetype) + call file_close(file_id) if (filetype /= FILETYPE_SOURCE) then call fatal_error("Second file after restart flag must be a & &source file") @@ -494,26 +495,26 @@ contains ! pairs are the id of the universe and the index in the array. In ! cells_in_univ_dict, it's the id of the universe and the number of cells. - pair_list => universe_dict % keys() + pair_list => universe_dict%keys() current => pair_list do while (associated(current)) ! Find index of universe in universes array - i_univ = current % value + i_univ = current%value univ => universes(i_univ) - univ % id = current % key + univ%id = current%key ! Check for lowest level universe - if (univ % id == 0) BASE_UNIVERSE = i_univ + if (univ%id == 0) BASE_UNIVERSE = i_univ ! Find cell count for this universe - n_cells_in_univ = cells_in_univ_dict % get_key(univ % id) + n_cells_in_univ = cells_in_univ_dict%get_key(univ%id) ! Allocate cell list for universe - allocate(univ % cells(n_cells_in_univ)) - univ % n_cells = n_cells_in_univ + allocate(univ%cells(n_cells_in_univ)) + univ%n_cells = n_cells_in_univ ! Move to next universe - next => current % next + next => current%next deallocate(current) current => next end do @@ -528,17 +529,17 @@ contains c => cells(i) ! Get pointer to corresponding universe - i_univ = universe_dict % get_key(c % universe) + i_univ = universe_dict%get_key(c%universe) univ => universes(i_univ) ! Increment the index for the cells array within the Universe object and ! then store the index of the Cell object in that array index_cell_in_univ(i_univ) = index_cell_in_univ(i_univ) + 1 - univ % cells(index_cell_in_univ(i_univ)) = i + univ%cells(index_cell_in_univ(i_univ)) = i end do ! Clear dictionary - call cells_in_univ_dict % clear() + call cells_in_univ_dict%clear() end subroutine prepare_universes @@ -568,15 +569,15 @@ contains ! ADJUST SURFACE LIST FOR EACH CELL c => cells(i) - do j = 1, c % n_surfaces - id = c % surfaces(j) + do j = 1, c%n_surfaces + id = c%surfaces(j) if (id < OP_DIFFERENCE) then - if (surface_dict % has_key(abs(id))) then - i_array = surface_dict % get_key(abs(id)) - c % surfaces(j) = sign(i_array, id) + if (surface_dict%has_key(abs(id))) then + i_array = surface_dict%get_key(abs(id)) + c%surfaces(j) = sign(i_array, id) else call fatal_error("Could not find surface " // trim(to_str(abs(id)))& - &// " specified on cell " // trim(to_str(c % id))) + &// " specified on cell " // trim(to_str(c%id))) end if end if end do @@ -584,40 +585,40 @@ contains ! ======================================================================= ! ADJUST UNIVERSE INDEX FOR EACH CELL - id = c % universe - if (universe_dict % has_key(id)) then - c % universe = universe_dict % get_key(id) + id = c%universe + if (universe_dict%has_key(id)) then + c%universe = universe_dict%get_key(id) else call fatal_error("Could not find universe " // trim(to_str(id)) & - &// " specified on cell " // trim(to_str(c % id))) + &// " specified on cell " // trim(to_str(c%id))) end if ! ======================================================================= ! ADJUST MATERIAL/FILL POINTERS FOR EACH CELL - id = c % material + id = c%material if (id == MATERIAL_VOID) then - c % type = CELL_NORMAL + c%type = CELL_NORMAL elseif (id /= 0) then - if (material_dict % has_key(id)) then - c % type = CELL_NORMAL - c % material = material_dict % get_key(id) + if (material_dict%has_key(id)) then + c%type = CELL_NORMAL + c%material = material_dict%get_key(id) else call fatal_error("Could not find material " // trim(to_str(id)) & - &// " specified on cell " // trim(to_str(c % id))) + &// " specified on cell " // trim(to_str(c%id))) end if else - id = c % fill - if (universe_dict % has_key(id)) then - c % type = CELL_FILL - c % fill = universe_dict % get_key(id) - elseif (lattice_dict % has_key(id)) then - lid = lattice_dict % get_key(id) - c % type = CELL_LATTICE - c % fill = lid + id = c%fill + if (universe_dict%has_key(id)) then + c%type = CELL_FILL + c%fill = universe_dict%get_key(id) + elseif (lattice_dict%has_key(id)) then + lid = lattice_dict%get_key(id) + c%type = CELL_LATTICE + c%fill = lid else call fatal_error("Specified fill " // trim(to_str(id)) // " on cell "& - &// trim(to_str(c % id)) // " is neither a universe nor a & + &// trim(to_str(c%id)) // " is neither a universe nor a & &lattice.") end if end if @@ -627,41 +628,41 @@ contains ! ADJUST UNIVERSE INDICES FOR EACH LATTICE do i = 1, n_lattices - lat => lattices(i) % obj + lat => lattices(i)%obj select type (lat) type is (RectLattice) - do m = 1, lat % n_cells(3) - do k = 1, lat % n_cells(2) - do j = 1, lat % n_cells(1) - id = lat % universes(j,k,m) - if (universe_dict % has_key(id)) then - lat % universes(j,k,m) = universe_dict % get_key(id) + do m = 1, lat%n_cells(3) + do k = 1, lat%n_cells(2) + do j = 1, lat%n_cells(1) + id = lat%universes(j,k,m) + if (universe_dict%has_key(id)) then + lat%universes(j,k,m) = universe_dict%get_key(id) else call fatal_error("Invalid universe number " & &// trim(to_str(id)) // " specified on lattice " & - &// trim(to_str(lat % id))) + &// trim(to_str(lat%id))) end if end do end do end do type is (HexLattice) - do m = 1, lat % n_axial - do k = 1, 2*lat % n_rings - 1 - do j = 1, 2*lat % n_rings - 1 - if (j + k < lat % n_rings + 1) then + do m = 1, lat%n_axial + do k = 1, 2*lat%n_rings - 1 + do j = 1, 2*lat%n_rings - 1 + if (j + k < lat%n_rings + 1) then cycle - else if (j + k > 3*lat % n_rings - 1) then + else if (j + k > 3*lat%n_rings - 1) then cycle end if - id = lat % universes(j, k, m) - if (universe_dict % has_key(id)) then - lat % universes(j, k, m) = universe_dict % get_key(id) + id = lat%universes(j, k, m) + if (universe_dict%has_key(id)) then + lat%universes(j, k, m) = universe_dict%get_key(id) else call fatal_error("Invalid universe number " & &// trim(to_str(id)) // " specified on lattice " & - &// trim(to_str(lat % id))) + &// trim(to_str(lat%id))) end if end do end do @@ -669,13 +670,13 @@ contains end select - if (lat % outer /= NO_OUTER_UNIVERSE) then - if (universe_dict % has_key(lat % outer)) then - lat % outer = universe_dict % get_key(lat % outer) + if (lat%outer /= NO_OUTER_UNIVERSE) then + if (universe_dict%has_key(lat%outer)) then + lat%outer = universe_dict%get_key(lat%outer) else call fatal_error("Invalid universe number " & - &// trim(to_str(lat % outer)) & - &// " specified on lattice " // trim(to_str(lat % id))) + &// trim(to_str(lat%outer)) & + &// " specified on lattice " // trim(to_str(lat%id))) end if end if @@ -687,68 +688,68 @@ contains ! ======================================================================= ! ADJUST INDICES FOR EACH TALLY FILTER - FILTER_LOOP: do j = 1, t % n_filters + FILTER_LOOP: do j = 1, t%n_filters - select case (t % filters(j) % type) + select case (t%filters(j)%type) case (FILTER_DISTRIBCELL) - do k = 1, size(t % filters(j) % int_bins) - id = t % filters(j) % int_bins(k) - if (cell_dict % has_key(id)) then - t % filters(j) % int_bins(k) = cell_dict % get_key(id) + do k = 1, size(t%filters(j)%int_bins) + id = t%filters(j)%int_bins(k) + if (cell_dict%has_key(id)) then + t%filters(j)%int_bins(k) = cell_dict%get_key(id) else call fatal_error("Could not find cell " // trim(to_str(id)) // & - " specified on tally " // trim(to_str(t % id))) + " specified on tally " // trim(to_str(t%id))) end if end do case (FILTER_CELL, FILTER_CELLBORN) - do k = 1, t % filters(j) % n_bins - id = t % filters(j) % int_bins(k) - if (cell_dict % has_key(id)) then - t % filters(j) % int_bins(k) = cell_dict % get_key(id) + do k = 1, t%filters(j)%n_bins + id = t%filters(j)%int_bins(k) + if (cell_dict%has_key(id)) then + t%filters(j)%int_bins(k) = cell_dict%get_key(id) else call fatal_error("Could not find cell " // trim(to_str(id)) & - &// " specified on tally " // trim(to_str(t % id))) + &// " specified on tally " // trim(to_str(t%id))) end if end do case (FILTER_SURFACE) ! Check if this is a surface filter only for surface currents - if (any(t % score_bins == SCORE_CURRENT)) cycle FILTER_LOOP + if (any(t%score_bins == SCORE_CURRENT)) cycle FILTER_LOOP - do k = 1, t % filters(j) % n_bins - id = t % filters(j) % int_bins(k) - if (surface_dict % has_key(id)) then - t % filters(j) % int_bins(k) = surface_dict % get_key(id) + do k = 1, t%filters(j)%n_bins + id = t%filters(j)%int_bins(k) + if (surface_dict%has_key(id)) then + t%filters(j)%int_bins(k) = surface_dict%get_key(id) else call fatal_error("Could not find surface " // trim(to_str(id)) & - &// " specified on tally " // trim(to_str(t % id))) + &// " specified on tally " // trim(to_str(t%id))) end if end do case (FILTER_UNIVERSE) - do k = 1, t % filters(j) % n_bins - id = t % filters(j) % int_bins(k) - if (universe_dict % has_key(id)) then - t % filters(j) % int_bins(k) = universe_dict % get_key(id) + do k = 1, t%filters(j)%n_bins + id = t%filters(j)%int_bins(k) + if (universe_dict%has_key(id)) then + t%filters(j)%int_bins(k) = universe_dict%get_key(id) else call fatal_error("Could not find universe " // trim(to_str(id)) & - &// " specified on tally " // trim(to_str(t % id))) + &// " specified on tally " // trim(to_str(t%id))) end if end do case (FILTER_MATERIAL) - do k = 1, t % filters(j) % n_bins - id = t % filters(j) % int_bins(k) - if (material_dict % has_key(id)) then - t % filters(j) % int_bins(k) = material_dict % get_key(id) + do k = 1, t%filters(j)%n_bins + id = t%filters(j)%int_bins(k) + if (material_dict%has_key(id)) then + t%filters(j)%int_bins(k) = material_dict%get_key(id) else call fatal_error("Could not find material " // trim(to_str(id)) & - &// " specified on tally " // trim(to_str(t % id))) + &// " specified on tally " // trim(to_str(t%id))) end if end do @@ -786,46 +787,46 @@ contains do i = 1, n_materials mat => materials(i) - percent_in_atom = (mat % atom_density(1) > ZERO) - density_in_atom = (mat % density > ZERO) + percent_in_atom = (mat%atom_density(1) > ZERO) + density_in_atom = (mat%density > ZERO) sum_percent = ZERO - do j = 1, mat % n_nuclides + do j = 1, mat%n_nuclides ! determine atomic weight ratio - index_list = xs_listing_dict % get_key(mat % names(j)) - awr = xs_listings(index_list) % awr + index_list = xs_listing_dict%get_key(mat%names(j)) + awr = xs_listings(index_list)%awr ! if given weight percent, convert all values so that they are divided ! by awr. thus, when a sum is done over the values, it's actually ! sum(w/awr) if (.not. percent_in_atom) then - mat % atom_density(j) = -mat % atom_density(j) / awr + mat%atom_density(j) = -mat%atom_density(j) / awr end if end do ! determine normalized atom percents. if given atom percents, this is ! straightforward. if given weight percents, the value is w/awr and is ! divided by sum(w/awr) - sum_percent = sum(mat % atom_density) - mat % atom_density = mat % atom_density / sum_percent + sum_percent = sum(mat%atom_density) + mat%atom_density = mat%atom_density / sum_percent ! Change density in g/cm^3 to atom/b-cm. Since all values are now in atom ! percent, the sum needs to be re-evaluated as 1/sum(x*awr) if (.not. density_in_atom) then sum_percent = ZERO - do j = 1, mat % n_nuclides - index_list = xs_listing_dict % get_key(mat % names(j)) - awr = xs_listings(index_list) % awr - x = mat % atom_density(j) + do j = 1, mat%n_nuclides + index_list = xs_listing_dict%get_key(mat%names(j)) + awr = xs_listings(index_list)%awr + x = mat%atom_density(j) sum_percent = sum_percent + x*awr end do sum_percent = ONE / sum_percent - mat % density = -mat % density * N_AVOGADRO & + mat%density = -mat%density * N_AVOGADRO & / MASS_NEUTRON * sum_percent end if ! Calculate nuclide atom densities - mat % atom_density = mat % density * mat % atom_density + mat%atom_density = mat%density * mat%atom_density end do end subroutine normalize_ao @@ -942,16 +943,16 @@ contains ! Get pointer to tally tally => tallies(i) - n_filt = tally % n_filters + n_filt = tally%n_filters ! Loop over the filters to determine how many additional filters ! need to be added to this tally - do j = 1, tally % n_filters + do j = 1, tally%n_filters ! Determine type of filter - if (tally % filters(j) % type == FILTER_DISTRIBCELL) then + if (tally%filters(j)%type == FILTER_DISTRIBCELL) then count_all = .true. - if (size(tally % filters(j) % int_bins) > 1) then + if (size(tally%filters(j)%int_bins) > 1) then call fatal_error("A distribcell filter was specified with & &multiple bins. This feature is not supported.") end if @@ -975,12 +976,12 @@ contains tally => tallies(i) ! Initialize the filters - do j = 1, tally % n_filters + do j = 1, tally%n_filters ! Set the number of bins to the number of instances of the cell - if (tally % filters(j) % type == FILTER_DISTRIBCELL) then - c => cells(tally % filters(j) % int_bins(1)) - tally % filters(j) % n_bins = c % instances + if (tally%filters(j)%type == FILTER_DISTRIBCELL) then + c => cells(tally%filters(j)%int_bins(1)) + tally%filters(j)%n_bins = c%instances end if end do @@ -1031,12 +1032,12 @@ contains do i = 1, n_tallies tally => tallies(i) - do j = 1, tally % n_filters - filter => tally % filters(j) + do j = 1, tally%n_filters + filter => tally%filters(j) - if (filter % type == FILTER_DISTRIBCELL) then - if (.not. cell_list % contains(filter % int_bins(1))) then - call cell_list % add(filter % int_bins(1)) + if (filter%type == FILTER_DISTRIBCELL) then + if (.not. cell_list%contains(filter%int_bins(1))) then + call cell_list%add(filter%int_bins(1)) end if end if @@ -1047,8 +1048,8 @@ contains ! to determine the number of offset tables to allocate do i = 1, n_universes univ => universes(i) - do j = 1, univ % n_cells - if (cell_list % contains(univ % cells(j))) then + do j = 1, univ%n_cells + if (cell_list%contains(univ%cells(j))) then n_maps = n_maps + 1 end if end do @@ -1070,29 +1071,29 @@ contains do i = 1, n_universes univ => universes(i) - do j = 1, univ % n_cells + do j = 1, univ%n_cells - if (cell_list % contains(univ % cells(j))) then + if (cell_list%contains(univ%cells(j))) then ! Loop over all tallies do l = 1, n_tallies tally => tallies(l) - do m = 1, tally % n_filters - filter => tally % filters(m) + do m = 1, tally%n_filters + filter => tally%filters(m) ! Loop over only distribcell filters ! If filter points to cell we just found, set offset index - if (filter % type == FILTER_DISTRIBCELL) then - if (filter % int_bins(1) == univ % cells(j)) then - filter % offset = k + if (filter%type == FILTER_DISTRIBCELL) then + if (filter%int_bins(1) == univ%cells(j)) then + filter%offset = k end if end if end do end do - univ_list(k) = univ % id + univ_list(k) = univ%id k = k + 1 end if end do @@ -1100,26 +1101,26 @@ contains ! Allocate the offset tables for lattices do i = 1, n_lattices - lat => lattices(i) % obj + lat => lattices(i)%obj select type(lat) type is (RectLattice) - allocate(lat % offset(n_maps, lat % n_cells(1), lat % n_cells(2), & - lat % n_cells(3))) + allocate(lat%offset(n_maps, lat%n_cells(1), lat%n_cells(2), & + lat%n_cells(3))) type is (HexLattice) - allocate(lat % offset(n_maps, 2 * lat % n_rings - 1, & - 2 * lat % n_rings - 1, lat % n_axial)) + allocate(lat%offset(n_maps, 2 * lat%n_rings - 1, & + 2 * lat%n_rings - 1, lat%n_axial)) end select - lat % offset(:, :, :, :) = 0 + lat%offset(:, :, :, :) = 0 end do ! Allocate offset table for fill cells do i = 1, n_cells - if (cells(i) % material == NONE) then - allocate(cells(i) % offset(n_maps)) + if (cells(i)%material == NONE) then + allocate(cells(i)%offset(n_maps)) end if end do diff --git a/src/output_interface.F90 b/src/output_interface.F90 deleted file mode 100644 index 1e08ce491..000000000 --- a/src/output_interface.F90 +++ /dev/null @@ -1,1725 +0,0 @@ -module output_interface - - use constants - use error, only: warning, fatal_error - use global - use tally_header, only: TallyResult - - use hdf5_interface - - implicit none - private - - type, public :: BinaryOutput - private - ! Compilation specific data - integer(HID_T) :: hdf5_fh - integer(HID_T) :: hdf5_grp - logical :: serial ! Serial I/O when using MPI/PHDF5 - contains - generic, public :: write_data => write_double, & - write_double_1Darray, & - write_double_2Darray, & - write_double_3Darray, & - write_double_4Darray, & - write_integer, & - write_integer_1Darray, & - write_integer_2Darray, & - write_integer_3Darray, & - write_integer_4Darray, & - write_long, & - write_string - generic, public :: read_data => read_double, & - read_double_1Darray, & - read_double_2Darray, & - read_double_3Darray, & - read_double_4Darray, & - read_integer, & - read_integer_1Darray, & - read_integer_2Darray, & - read_integer_3Darray, & - read_integer_4Darray, & - read_long, & - read_string - procedure :: write_double => write_double - procedure :: write_double_1Darray => write_double_1Darray - procedure :: write_double_2Darray => write_double_2Darray - procedure :: write_double_3Darray => write_double_3Darray - procedure :: write_double_4Darray => write_double_4Darray - procedure :: write_integer => write_integer - procedure :: write_integer_1Darray => write_integer_1Darray - procedure :: write_integer_2Darray => write_integer_2Darray - procedure :: write_integer_3Darray => write_integer_3Darray - procedure :: write_integer_4Darray => write_integer_4Darray - procedure :: write_long => write_long - procedure :: write_string => write_string - procedure :: read_double => read_double - procedure :: read_double_1Darray => read_double_1Darray - procedure :: read_double_2Darray => read_double_2Darray - procedure :: read_double_3Darray => read_double_3Darray - procedure :: read_double_4Darray => read_double_4Darray - procedure :: read_integer => read_integer - procedure :: read_integer_1Darray => read_integer_1Darray - procedure :: read_integer_2Darray => read_integer_2Darray - procedure :: read_integer_3Darray => read_integer_3Darray - procedure :: read_integer_4Darray => read_integer_4Darray - procedure :: read_long => read_long - procedure :: read_string => read_string - procedure, public :: file_create => file_create - procedure, public :: file_open => file_open - procedure, public :: file_close => file_close - procedure, public :: write_tally_result => write_tally_result - procedure, public :: read_tally_result => read_tally_result - procedure, public :: write_source_bank => write_source_bank - procedure, public :: read_source_bank => read_source_bank - procedure, public :: write_attribute_string => write_attribute_string - procedure, public :: open_group => open_group - procedure, public :: close_group => close_group - end type BinaryOutput - -contains - -!=============================================================================== -! FILE_CREATE creates a new file to write data to -!=============================================================================== - - subroutine file_create(self, filename, serial) - - character(*), intent(in) :: filename ! name of file to be created - logical, optional, intent(in) :: serial ! processor rank to write from - class(BinaryOutput) :: self - - ! Check for serial option - if (present(serial)) then - self % serial = serial - else - self % serial = .true. - end if - -#ifdef PHDF5 - if (self % serial) then - call hdf5_file_create(filename, self % hdf5_fh) - else - call hdf5_file_create_parallel(filename, self % hdf5_fh) - endif -#else - call hdf5_file_create(filename, self % hdf5_fh) -#endif - - end subroutine file_create - -!=============================================================================== -! FILE_OPEN opens an existing file for reading or read/writing -!=============================================================================== - - subroutine file_open(self, filename, mode, serial) - - character(*), intent(in) :: filename ! name of file to be opened - character(*), intent(in) :: mode ! file access mode - logical, optional, intent(in) :: serial ! processor rank to write from - class(BinaryOutput) :: self - - ! Check for serial option - if (present(serial)) then - self % serial = serial - else - self % serial = .true. - end if - -#ifdef PHDF5 - if (self % serial) then - call hdf5_file_open(filename, self % hdf5_fh, mode) - else - call hdf5_file_open_parallel(filename, self % hdf5_fh, mode) - endif -#else - call hdf5_file_open(filename, self % hdf5_fh, mode) -#endif - - end subroutine file_open - -!=============================================================================== -! FILE_CLOSE closes a file -!=============================================================================== - - subroutine file_close(self) - - class(BinaryOutput) :: self - - call hdf5_file_close(self % hdf5_fh) - - end subroutine file_close - -!=============================================================================== -! OPEN_GROUP call hdf5 routine to open a group within binary output context -!=============================================================================== - - subroutine open_group(self, group) - - character(*), intent(in) :: group ! HDF5 group name - class(BinaryOutput) :: self - - call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) - - end subroutine open_group - -!=============================================================================== -! CLOSE_GROUP call hdf5 routine to close a group within binary output context -!=============================================================================== - - subroutine close_group(self) - - class(BinaryOutput) :: self - - call hdf5_close_group(self % hdf5_grp) - - end subroutine close_group - -!=============================================================================== -! WRITE_DOUBLE writes double precision scalar data -!=============================================================================== - - subroutine write_double(self, buffer, name, group, collect) - - real(8), intent(in) :: buffer ! data to write - character(*), intent(in) :: name ! name for data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_write_double(self % hdf5_grp, name_, buffer) - else - call hdf5_write_double_parallel(self % hdf5_grp, name_, buffer, collect_) - end if -#else - call hdf5_write_double(self % hdf5_grp, name_, buffer) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_double - -!=============================================================================== -! READ_DOUBLE reads double precision scalar data -!=============================================================================== - - subroutine read_double(self, buffer, name, group, collect) - - real(8), intent(inout) :: buffer ! read data to here - character(*), intent(in) :: name ! name for data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_read_double(self % hdf5_grp, name_, buffer) - else - call hdf5_read_double_parallel(self % hdf5_grp, name_, buffer, collect_) - end if -#else - call hdf5_read_double(self % hdf5_grp, name_, buffer) -#endif - ! Check if HDf5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_double - -!=============================================================================== -! WRITE_DOUBLE_1DARRAY writes double precision 1-D array data -!=============================================================================== - - subroutine write_double_1Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length ! length of array to write - real(8), intent(in) :: buffer(:) ! data to write - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_write_double_1Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_write_double_1Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - call hdf5_write_double_1Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_double_1Darray - -!=============================================================================== -! READ_DOUBLE_1DARRAY reads double precision 1-D array data -!=============================================================================== - - subroutine read_double_1Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length ! length of array to read - real(8), intent(inout) :: buffer(:) ! read data to here - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_read_double_1Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_read_double_1Darray_parallel(self % hdf5_grp, name_, buffer, & - length, collect_) - end if -#else - call hdf5_read_double_1Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_double_1Darray - -!=============================================================================== -! WRITE_DOUBLE_2DARRAY writes double precision 2-D array data -!=============================================================================== - - subroutine write_double_2Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length(2) ! dimension of array - real(8), intent(in) :: buffer(length(1),length(2)) ! the data - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_write_double_2Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_write_double_2Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - call hdf5_write_double_2Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_double_2Darray - -!=============================================================================== -! READ_DOUBLE_2DARRAY reads double precision 2-D array data -!=============================================================================== - - subroutine read_double_2Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length(2) ! dimension of array - real(8), intent(inout) :: buffer(length(1),length(2)) ! the data - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_read_double_2Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_read_double_2Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - call hdf5_read_double_2Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_double_2Darray - -!=============================================================================== -! WRITE_DOUBLE_3DARRAY writes double precision 3-D array data -!=============================================================================== - - subroutine write_double_3Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length(3) ! length of each dimension - real(8), intent(in) :: buffer(length(1),length(2),length(3)) - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_write_double_3Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_write_double_3Darray_parallel(self % hdf5_grp, name_, buffer, & - length, collect_) - end if -#else - call hdf5_write_double_3Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_double_3Darray - -!=============================================================================== -! READ_DOUBLE_3DARRAY reads double precision 3-D array data -!=============================================================================== - - subroutine read_double_3Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length(3) ! length of each dimension - real(8), intent(inout) :: buffer(length(1),length(2),length(3)) - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_read_double_3Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_read_double_3Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - call hdf5_read_double_3Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_double_3Darray - -!=============================================================================== -! WRITE_DOUBLE_4DARRAY writes double precision 4-D array data -!=============================================================================== - - subroutine write_double_4Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length(4) ! length of each dimension - real(8), intent(in) :: buffer(length(1),length(2),& - length(3),length(4)) - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_write_double_4Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_write_double_4Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - ! Write the data in serial - call hdf5_write_double_4Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_double_4Darray - -!=============================================================================== -! READ_DOUBLE_4DARRAY reads double precision 4-D array data -!=============================================================================== - - subroutine read_double_4Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length(4) ! length of each dimension - real(8), intent(inout) :: buffer(length(1),length(2),& - length(3),length(4)) - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_read_double_4Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_read_double_4Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - call hdf5_read_double_4Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_double_4Darray - -!=============================================================================== -! WRITE_INTEGER writes integer precision scalar data -!=============================================================================== - - subroutine write_integer(self, buffer, name, group, collect) - - integer, intent(in) :: buffer ! data to write - character(*), intent(in) :: name ! name for data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_write_integer(self % hdf5_grp, name_, buffer) - else - call hdf5_write_integer_parallel(self % hdf5_grp, name_, buffer, collect_) - end if -#else - call hdf5_write_integer(self % hdf5_grp, name_, buffer) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_integer - -!=============================================================================== -! READ_INTEGER reads integer precision scalar data -!=============================================================================== - - subroutine read_integer(self, buffer, name, group, collect) - - integer, intent(inout) :: buffer ! read data to here - character(*), intent(in) :: name ! name for data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_read_integer(self % hdf5_grp, name_, buffer) - else - call hdf5_read_integer_parallel(self % hdf5_grp, name_, buffer, collect_) - end if -#else - call hdf5_read_integer(self % hdf5_grp, name_, buffer) -#endif - ! Check if HDf5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_integer - -!=============================================================================== -! WRITE_INTEGER_1DARRAY writes integer precision 1-D array data -!=============================================================================== - - subroutine write_integer_1Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length ! length of array to write - integer, intent(in) :: buffer(:) ! data to write - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_write_integer_1Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_write_integer_1Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - call hdf5_write_integer_1Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_integer_1Darray - -!=============================================================================== -! READ_INTEGER_1DARRAY reads integer precision 1-D array data -!=============================================================================== - - subroutine read_integer_1Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length ! length of array to read - integer, intent(inout) :: buffer(:) ! read data to here - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_read_integer_1Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_read_integer_1Darray_parallel(self % hdf5_grp, name_, buffer, & - length, collect_) - end if -#else - ! Read the data in serial - call hdf5_read_integer_1Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_integer_1Darray - -!=============================================================================== -! WRITE_INTEGER_2DARRAY writes integer precision 2-D array data -!=============================================================================== - - subroutine write_integer_2Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length(2) ! dimension of array - integer, intent(in) :: buffer(length(1),length(2)) ! the data - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_write_integer_2Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_write_integer_2Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - call hdf5_write_integer_2Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_integer_2Darray - -!=============================================================================== -! READ_INTEGER_2DARRAY reads integer precision 2-D array data -!=============================================================================== - - subroutine read_integer_2Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length(2) ! dimension of array - integer, intent(inout) :: buffer(length(1),length(2)) ! the data - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_read_integer_2Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_read_integer_2Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - call hdf5_read_integer_2Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_integer_2Darray - -!=============================================================================== -! WRITE_INTEGER_3DARRAY writes integer precision 3-D array data -!=============================================================================== - - subroutine write_integer_3Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length(3) ! length of each dimension - integer, intent(in) :: buffer(length(1),length(2),length(3)) - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_write_integer_3Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_write_integer_3Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - call hdf5_write_integer_3Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_integer_3Darray - -!=============================================================================== -! READ_INTEGER_3DARRAY reads integer precision 3-D array data -!=============================================================================== - - subroutine read_integer_3Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length(3) ! length of each dimension - integer, intent(inout) :: buffer(length(1),length(2),length(3)) - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_read_integer_3Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_read_integer_3Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - call hdf5_read_integer_3Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_integer_3Darray - -!=============================================================================== -! WRITE_INTEGER_4DARRAY writes integer precision 4-D array data -!=============================================================================== - - subroutine write_integer_4Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length(4) ! length of each dimension - integer, intent(in) :: buffer(length(1),length(2),& - length(3),length(4)) - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_write_integer_4Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_write_integer_4Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - call hdf5_write_integer_4Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_integer_4Darray - -!=============================================================================== -! READ_INTEGER_4DARRAY reads integer precision 4-D array data -!=============================================================================== - - subroutine read_integer_4Darray(self, buffer, name, group, length, collect) - - integer, intent(in) :: length(4) ! length of each dimension - integer, intent(inout) :: buffer(length(1),length(2),& - length(3),length(4)) - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_read_integer_4Darray(self % hdf5_grp, name_, buffer, length) - else - call hdf5_read_integer_4Darray_parallel(self % hdf5_grp, name_, buffer, length, & - collect_) - end if -#else - call hdf5_read_integer_4Darray(self % hdf5_grp, name_, buffer, length) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_integer_4Darray - -!=============================================================================== -! WRITE_LONG writes long integer scalar data -!=============================================================================== - - subroutine write_long(self, buffer, name, group, collect) - - integer(8), intent(in) :: buffer ! data to write - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_write_long(self % hdf5_grp, name_, buffer, hdf5_integer8_t) - else - call hdf5_write_long_parallel(self % hdf5_grp, name_, buffer, & - hdf5_integer8_t, collect_) - end if -#else - call hdf5_write_long(self % hdf5_grp, name_, buffer, hdf5_integer8_t) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_long - -!=============================================================================== -! READ_LONG reads long integer scalar data -!=============================================================================== - - subroutine read_long(self, buffer, name, group, collect) - - integer(8), intent(inout) :: buffer ! data to write - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - logical :: collect_ - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_read_long(self % hdf5_grp, name_, buffer, hdf5_integer8_t) - else - call hdf5_read_long_parallel(self % hdf5_grp, name_, buffer, & - hdf5_integer8_t, collect_) - end if -#else - call hdf5_read_long(self % hdf5_grp, name_, buffer, hdf5_integer8_t) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_long - -!=============================================================================== -! WRITE_STRING writes string data -!=============================================================================== - - subroutine write_string(self, buffer, name, group, collect) - - character(*), intent(in) :: buffer ! data to write - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - integer :: n - logical :: collect_ - - ! Get string length - n = len_trim(buffer) - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_write_string(self % hdf5_grp, name_, buffer, n) - else - call hdf5_write_string_parallel(self % hdf5_grp, name_, buffer, n, collect_) - end if -#else - ! Write the data - call hdf5_write_string(self % hdf5_grp, name_, buffer, n) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_string - -!=============================================================================== -! READ_STRING reads string data -!=============================================================================== - - subroutine read_string(self, buffer, name, group, collect) - - character(*), intent(inout) :: buffer ! data to write - character(*), intent(in) :: name ! name of data - character(*), intent(in), optional :: group ! HDF5 group name - logical, intent(in), optional :: collect ! collective I/O - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - integer :: n - logical :: collect_ - - ! Get string length - n = len(buffer) - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Set up collective vs. independent I/O - if (present(collect)) then - collect_ = collect - else - collect_ = .true. - end if - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif -#ifdef PHDF5 - if (self % serial) then - call hdf5_read_string(self % hdf5_grp, name_, buffer, n) - else - call hdf5_read_string_parallel(self % hdf5_grp, name_, buffer, n, collect_) - end if -#else - call hdf5_read_string(self % hdf5_grp, name_, buffer, n) -#endif - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_string - -!=============================================================================== -! WRITE_ATTRIBUTE_STRING -!=============================================================================== - - subroutine write_attribute_string(self, var, attr_type, attr_str, group) - - character(*), intent(in) :: var ! variable name for attr - character(*), intent(in) :: attr_type ! attr identifier type - character(*), intent(in) :: attr_str ! string for attr id type - character(*), intent(in), optional :: group ! HDF5 group name - class(BinaryOutput) :: self - - ! Check if HDF5 group should be created/opened - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - endif - - ! Write the attribute string - call hdf5_write_attribute_string(self % hdf5_grp, var, attr_type, attr_str) - - ! Check if HDF5 group should be closed - if (present(group)) call hdf5_close_group(self % hdf5_grp) - - end subroutine write_attribute_string - -!=============================================================================== -! WRITE_TALLY_RESULT writes an OpenMC TallyResult type -!=============================================================================== - - subroutine write_tally_result(self, buffer, name, group, n1, n2) - - character(*), intent(in), optional :: group ! HDF5 group name - character(*), intent(in) :: name ! name of data - integer, intent(in) :: n1, n2 ! TallyResult dims - type(TallyResult), intent(in), target :: buffer(n1, n2) ! data to write - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Open up sub-group if present - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - end if - - ! Set overall size of vector to write - dims1(1) = n1*n2 - - ! Create up a dataspace for size - call h5screate_simple_f(1, dims1, dspace, hdf5_err) - - ! Create the dataset - call h5dcreate_f(self % hdf5_grp, name_, hdf5_tallyresult_t, dspace, dset, & - hdf5_err) - - ! Set pointer to first value and write - f_ptr = c_loc(buffer(1,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(self % hdf5_grp) - end if - - end subroutine write_tally_result - -!=============================================================================== -! READ_TALLY_RESULT reads OpenMC TallyResult data -!=============================================================================== - - subroutine read_tally_result(self, buffer, name, group, n1, n2) - - character(*), intent(in), optional :: group ! HDF5 group name - character(*), intent(in) :: name ! name of data - integer, intent(in) :: n1, n2 ! TallyResult dims - type(TallyResult), intent(inout), target :: buffer(n1, n2) ! read data here - class(BinaryOutput) :: self - - character(len=MAX_WORD_LEN) :: name_ ! HDF5 dataset name - character(len=MAX_WORD_LEN) :: group_ ! HDF5 group name - - ! Set name - name_ = trim(name) - - ! Set group - if (present(group)) then - group_ = trim(group) - end if - - ! Open up sub-group if present - if (present(group)) then - call hdf5_open_group(self % hdf5_fh, group_, self % hdf5_grp) - else - self % hdf5_grp = self % hdf5_fh - end if - - ! Open the dataset - call h5dopen_f(self % hdf5_grp, 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)) call hdf5_close_group(self % hdf5_grp) - - end subroutine read_tally_result - -!=============================================================================== -! WRITE_SOURCE_BANK writes OpenMC source_bank data -!=============================================================================== - - subroutine write_source_bank(self) - - class(BinaryOutput) :: self - -#ifdef PHDF5 - integer(8) :: offset(1) ! source data offset -#endif - -#ifdef PHDF5 - - ! Set size of total dataspace for all procs and rank - dims1(1) = n_particles - hdf5_rank = 1 - - ! Create that dataspace - call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) - - ! Create the dataset for that dataspace - call h5dcreate_f(self % hdf5_fh, "source_bank", 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 - 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) = work_index(rank) - 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) - 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 - - ! Set size - dims1(1) = work - hdf5_rank = 1 - - ! Create dataspace - call h5screate_simple_f(hdf5_rank, dims1, dspace, hdf5_err) - - ! Create dataset - call h5dcreate_f(self % 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 - - end subroutine write_source_bank - -!=============================================================================== -! READ_SOURCE_BANK reads OpenMC source_bank data -!=============================================================================== - - subroutine read_source_bank(self) - - class(BinaryOutput) :: self - -#ifdef PHDF5 - integer(8) :: offset(1) ! offset of data -#endif - -#ifdef PHDF5 - - ! Set size of total dataspace for all procs and rank - dims1(1) = n_particles - hdf5_rank = 1 - - ! Open the dataset - call h5dopen_f(self % hdf5_fh, "source_bank", dset, hdf5_err) - - ! Create another data space but for each proc individually - 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) = work_index(rank) - 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) - 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 - - ! Open dataset - call h5dopen_f(self % 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 - - end subroutine read_source_bank - -end module output_interface diff --git a/src/particle_restart.F90 b/src/particle_restart.F90 index 0ed25fdc8..c8874b071 100644 --- a/src/particle_restart.F90 +++ b/src/particle_restart.F90 @@ -6,18 +6,18 @@ module particle_restart use constants use geometry_header, only: BASE_UNIVERSE use global + use hdf5_interface, only: file_open, file_close, read_dataset use output, only: write_message, print_particle - use output_interface, only: BinaryOutput use particle_header, only: Particle use random_lcg, only: set_particle_seed use tracking, only: transport + use hdf5, only: HID_T + implicit none private public :: run_particle_restart - type(BinaryOutput) :: pr ! Binary file - contains !=============================================================================== @@ -34,7 +34,7 @@ contains verbosity = 10 ! Initialize the particle to be tracked - call p % initialize() + call p%initialize() ! Read in the restart information call read_particle_restart(p, previous_run_mode) @@ -46,9 +46,9 @@ contains select case (previous_run_mode) case (MODE_EIGENVALUE) particle_seed = ((current_batch - 1)*gen_per_batch + & - current_gen - 1)*n_particles + p % id + current_gen - 1)*n_particles + p%id case (MODE_FIXEDSOURCE) - particle_seed = p % id + particle_seed = p%id end select call set_particle_seed(particle_seed) @@ -66,40 +66,41 @@ contains !=============================================================================== subroutine read_particle_restart(p, previous_run_mode) + type(Particle), intent(inout) :: p + integer, intent(inout) :: previous_run_mode integer :: int_scalar - integer, intent(inout) :: previous_run_mode - type(Particle), intent(inout) :: p + integer(HID_T) :: file_id ! Write meessage call write_message("Loading particle restart file " & &// trim(path_particle_restart) // "...", 1) ! Open file - call pr % file_open(path_particle_restart, 'r') + file_id = file_open(path_particle_restart, 'r') ! Read data from file - call pr % read_data(int_scalar, 'filetype') - call pr % read_data(int_scalar, 'revision') - call pr % read_data(current_batch, 'current_batch') - call pr % read_data(gen_per_batch, 'gen_per_batch') - call pr % read_data(current_gen, 'current_gen') - call pr % read_data(n_particles, 'n_particles') - call pr % read_data(previous_run_mode, 'run_mode') - call pr % read_data(p % id, 'id') - call pr % read_data(p % wgt, 'weight') - call pr % read_data(p % E, 'energy') - call pr % read_data(p % coord(1) % xyz, 'xyz', length=3) - call pr % read_data(p % coord(1) % uvw, 'uvw', length=3) + call read_dataset(file_id, 'filetype', int_scalar) + call read_dataset(file_id, 'revision', int_scalar) + call read_dataset(file_id, 'current_batch', current_batch) + call read_dataset(file_id, 'gen_per_batch', gen_per_batch) + call read_dataset(file_id, 'current_gen', current_gen) + call read_dataset(file_id, 'n_particles', n_particles) + call read_dataset(file_id, 'run_mode', previous_run_mode) + call read_dataset(file_id, 'id', p%id) + call read_dataset(file_id, 'weight', p%wgt) + call read_dataset(file_id, 'energy', p%E) + call read_dataset(file_id, 'xyz', p%coord(1)%xyz) + call read_dataset(file_id, 'uvw', p%coord(1)%uvw) ! Set particle last attributes - p % last_wgt = p % wgt - p % last_xyz = p % coord(1) % xyz - p % last_uvw = p % coord(1) % uvw - p % last_E = p % E + p%last_wgt = p%wgt + p%last_xyz = p%coord(1)%xyz + p%last_uvw = p%coord(1)%uvw + p%last_E = p%E ! Close hdf5 file - call pr % file_close() + call file_close(file_id) end subroutine read_particle_restart diff --git a/src/particle_restart_write.F90 b/src/particle_restart_write.F90 index 48b4af661..0c010b64c 100644 --- a/src/particle_restart_write.F90 +++ b/src/particle_restart_write.F90 @@ -2,17 +2,16 @@ module particle_restart_write use bank_header, only: Bank use global - use output_interface, only: BinaryOutput + use hdf5_interface use particle_header, only: Particle use string, only: to_str + use hdf5 + implicit none private public :: write_particle_restart - ! Binary output file - type(BinaryOutput) :: pr - contains !=============================================================================== @@ -20,43 +19,42 @@ contains !=============================================================================== subroutine write_particle_restart(p) - type(Particle), intent(in) :: p + integer(HID_T) :: file_id character(MAX_FILE_LEN) :: filename - type(Bank), pointer :: src => null() + type(Bank), pointer :: src ! Dont write another restart file if in particle restart mode if (run_mode == MODE_PARTICLE) return ! Set up file name filename = trim(path_output) // 'particle_' // trim(to_str(current_batch)) & - // '_' // trim(to_str(p % id)) - filename = trim(filename) // '.h5' + // '_' // trim(to_str(p%id)) // '.h5' !$omp critical (WriteParticleRestart) ! Create file - call pr % file_create(filename) + file_id = file_create(filename) ! Get information about source particle src => source_bank(current_work) ! Write data to file - call pr % write_data(FILETYPE_PARTICLE_RESTART, 'filetype') - call pr % write_data(REVISION_PARTICLE_RESTART, 'revision') - call pr % write_data(current_batch, 'current_batch') - call pr % write_data(gen_per_batch, 'gen_per_batch') - call pr % write_data(current_gen, 'current_gen') - call pr % write_data(n_particles, 'n_particles') - call pr % write_data(run_mode, 'run_mode') - call pr % write_data(p % id, 'id') - call pr % write_data(src % wgt, 'weight') - call pr % write_data(src % E, 'energy') - call pr % write_data(src % xyz, 'xyz', length = 3) - call pr % write_data(src % uvw, 'uvw', length = 3) + call write_dataset(file_id, 'filetype', FILETYPE_PARTICLE_RESTART) + call write_dataset(file_id, 'revision', REVISION_PARTICLE_RESTART) + call write_dataset(file_id, 'current_batch', current_batch) + call write_dataset(file_id, 'gen_per_batch', gen_per_batch) + call write_dataset(file_id, 'current_gen', current_gen) + call write_dataset(file_id, 'n_particles', n_particles) + call write_dataset(file_id, 'run_mode', run_mode) + call write_dataset(file_id, 'id', p%id) + call write_dataset(file_id, 'weight', src%wgt) + call write_dataset(file_id, 'energy', src%E) + call write_dataset(file_id, 'xyz', src%xyz) + call write_dataset(file_id, 'uvw', src%uvw) ! Close file - call pr % file_close() + call file_close(file_id) !$omp end critical (WriteParticleRestart) end subroutine write_particle_restart diff --git a/src/source.F90 b/src/source.F90 index 4b0de58b5..285332ef8 100644 --- a/src/source.F90 +++ b/src/source.F90 @@ -6,17 +6,20 @@ module source use geometry, only: find_cell use geometry_header, only: BASE_UNIVERSE use global + use hdf5_interface, only: file_create, file_open, file_close, read_dataset use math, only: maxwell_spectrum, watt_spectrum use output, only: write_message - use output_interface, only: BinaryOutput use particle_header, only: Particle use random_lcg, only: prn, set_particle_seed, prn_set_stream + use state_point, only: read_source_bank, write_source_bank use string, only: to_str #ifdef MPI use message_passing #endif + use hdf5, only: HID_T + implicit none contains @@ -27,12 +30,12 @@ contains subroutine initialize_source() - character(MAX_FILE_LEN) :: filename integer(8) :: i ! loop index over bank sites integer(8) :: id ! particle id integer(4) :: itmp ! temporary integer - type(Bank), pointer :: src => null() ! source bank site - type(BinaryOutput) :: sp ! statepoint/source binary file + integer(HID_T) :: file_id + character(MAX_FILE_LEN) :: filename + type(Bank), pointer :: src ! source bank site call write_message("Initializing source particles...", 6) @@ -44,10 +47,10 @@ contains &// '...', 6) ! Open the binary file - call sp % file_open(path_source, 'r', serial = .false.) + file_id = file_open(path_source, 'r', parallel=.true.) ! Read the file type - call sp % read_data(itmp, "filetype") + call read_dataset(file_id, "filetype", itmp) ! Check to make sure this is a source file if (itmp /= FILETYPE_SOURCE) then @@ -56,10 +59,10 @@ contains end if ! Read in the source bank - call sp % read_source_bank() + call read_source_bank(file_id) ! Close file - call sp % file_close() + call file_close(file_id) else ! Generation source sites from specified distribution in user input @@ -80,9 +83,9 @@ contains if (write_initial_source) then call write_message('Writing out initial source...', 1) filename = trim(path_output) // 'initial_source.h5' - call sp % file_create(filename, serial = .false.) - call sp % write_source_bank() - call sp % file_close() + file_id = file_create(filename, parallel=.true.) + call write_source_bank(file_id) + call file_close(file_id) end if end subroutine initialize_source @@ -109,28 +112,28 @@ contains integer, save :: num_resamples = 0 ! Number of resamples encountered ! Set weight to one by default - site % wgt = ONE + site%wgt = ONE ! Set the random number generator to the source stream. call prn_set_stream(STREAM_SOURCE) ! Sample position - select case (external_source % type_space) + select case (external_source%type_space) case (SRC_SPACE_BOX) ! Set particle defaults - call p % initialize() + call p%initialize() ! Repeat sampling source location until a good site has been found found = .false. do while (.not.found) ! Coordinates sampled uniformly over a box - p_min = external_source % params_space(1:3) - p_max = external_source % params_space(4:6) + p_min = external_source%params_space(1:3) + p_max = external_source%params_space(4:6) r = (/ (prn(), i = 1,3) /) - site % xyz = p_min + r*(p_max - p_min) + site%xyz = p_min + r*(p_max - p_min) ! Fill p with needed data - p % coord(1) % xyz = site % xyz - p % coord(1) % uvw = [ ONE, ZERO, ZERO ] + p%coord(1)%xyz = site%xyz + p%coord(1)%uvw = [ ONE, ZERO, ZERO ] ! Now search to see if location exists in geometry call find_cell(p, found) @@ -142,24 +145,24 @@ contains end if end if end do - call p % clear() + call p%clear() case (SRC_SPACE_FISSION) ! Repeat sampling source location until a good site has been found found = .false. do while (.not.found) ! Set particle defaults - call p % initialize() + call p%initialize() ! Coordinates sampled uniformly over a box - p_min = external_source % params_space(1:3) - p_max = external_source % params_space(4:6) + p_min = external_source%params_space(1:3) + p_max = external_source%params_space(4:6) r = (/ (prn(), i = 1,3) /) - site % xyz = p_min + r*(p_max - p_min) + site%xyz = p_min + r*(p_max - p_min) ! Fill p with needed data - p % coord(1) % xyz = site % xyz - p % coord(1) % uvw = [ ONE, ZERO, ZERO ] + p%coord(1)%xyz = site%xyz + p%coord(1)%uvw = [ ONE, ZERO, ZERO ] ! Now search to see if location exists in geometry call find_cell(p, found) @@ -171,66 +174,66 @@ contains end if cycle end if - if (p % material == MATERIAL_VOID) then + if (p%material == MATERIAL_VOID) then found = .false. cycle end if - if (.not. materials(p % material) % fissionable) found = .false. + if (.not. materials(p%material)%fissionable) found = .false. end do - call p % clear() + call p%clear() case (SRC_SPACE_POINT) ! Point source - site % xyz = external_source % params_space + site%xyz = external_source%params_space end select ! Sample angle - select case (external_source % type_angle) + select case (external_source%type_angle) case (SRC_ANGLE_ISOTROPIC) ! Sample isotropic distribution phi = TWO*PI*prn() mu = TWO*prn() - ONE - site % uvw(1) = mu - site % uvw(2) = sqrt(ONE - mu*mu) * cos(phi) - site % uvw(3) = sqrt(ONE - mu*mu) * sin(phi) + site%uvw(1) = mu + site%uvw(2) = sqrt(ONE - mu*mu) * cos(phi) + site%uvw(3) = sqrt(ONE - mu*mu) * sin(phi) case (SRC_ANGLE_MONO) ! Monodirectional source - site % uvw = external_source % params_angle + site%uvw = external_source%params_angle case default call fatal_error("No angle distribution specified for external source!") end select ! Sample energy distribution - select case (external_source % type_energy) + select case (external_source%type_energy) case (SRC_ENERGY_MONO) ! Monoenergtic source - site % E = external_source % params_energy(1) - if (site % E >= 20) then + site%E = external_source%params_energy(1) + if (site%E >= 20) then call fatal_error("Source energies above 20 MeV not allowed.") end if case (SRC_ENERGY_MAXWELL) - a = external_source % params_energy(1) + a = external_source%params_energy(1) do ! Sample Maxwellian fission spectrum - site % E = maxwell_spectrum(a) + site%E = maxwell_spectrum(a) ! resample if energy is >= 20 MeV - if (site % E < 20) exit + if (site%E < 20) exit end do case (SRC_ENERGY_WATT) - a = external_source % params_energy(1) - b = external_source % params_energy(2) + a = external_source%params_energy(1) + b = external_source%params_energy(2) do ! Sample Watt fission spectrum - site % E = watt_spectrum(a, b) + site%E = watt_spectrum(a, b) ! resample if energy is >= 20 MeV - if (site % E < 20) exit + if (site%E < 20) exit end do case default diff --git a/src/state_point.F90 b/src/state_point.F90 index 790fd58c5..084289bee 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -15,9 +15,9 @@ module state_point use constants use error, only: fatal_error, warning use global + use hdf5_interface use output, only: write_message, time_stamp use string, only: to_str, zero_padded, count_digits - use output_interface use tally_header, only: TallyObject use mesh_header, only: StructuredMesh use dict_header, only: ElemKeyValueII, ElemKeyValueCI @@ -26,9 +26,9 @@ module state_point use message_passing #endif - implicit none + use hdf5 - type(BinaryOutput) :: sp ! Statepoint/source output file + implicit none contains @@ -38,23 +38,26 @@ contains subroutine write_state_point() - character(MAX_FILE_LEN) :: filename integer :: i, j, k + integer :: n_order ! loop index for moment orders + integer :: nm_order ! loop index for Ynm moment orders integer, allocatable :: id_array(:) integer, allocatable :: key_array(:) + integer(HID_T) :: file_id + integer(HID_T) :: cmfd_group + integer(HID_T) :: tallies_group, tally_group + integer(HID_T) :: meshes_group, mesh_group + integer(HID_T) :: filter_group, moments_group + character(8) :: moment_name ! name of moment (e.g, P3) + character(MAX_FILE_LEN) :: filename type(StructuredMesh), pointer :: mesh type(TallyObject), pointer :: tally type(ElemKeyValueII), pointer :: current type(ElemKeyValueII), pointer :: next - character(8) :: moment_name ! name of moment (e.g, P3) - integer :: n_order ! loop index for moment orders - integer :: nm_order ! loop index for Ynm moment orders ! Set filename for state point filename = trim(path_output) // 'statepoint.' // & & zero_padded(current_batch, count_digits(n_max_batches)) - - ! Append appropriate extension filename = trim(filename) // '.h5' ! Write message @@ -62,145 +65,126 @@ contains if (master) then ! Create statepoint file - call sp % file_create(filename) + file_id = file_create(filename) ! Write file type - call sp % write_data(FILETYPE_STATEPOINT, "filetype") + call write_dataset(file_id, "filetype", FILETYPE_STATEPOINT) ! Write revision number for state point file - call sp % write_data(REVISION_STATEPOINT, "revision") + call write_dataset(file_id, "revision", REVISION_STATEPOINT) ! Write OpenMC version - call sp % write_data(VERSION_MAJOR, "version_major") - call sp % write_data(VERSION_MINOR, "version_minor") - call sp % write_data(VERSION_RELEASE, "version_release") + call write_dataset(file_id, "version_major", VERSION_MAJOR) + call write_dataset(file_id, "version_minor", VERSION_MINOR) + call write_dataset(file_id, "version_release", VERSION_RELEASE) ! Write current date and time - call sp % write_data(time_stamp(), "date_and_time") + call write_dataset(file_id, "date_and_time", time_stamp()) ! Write path to input - call sp % write_data(path_input, "path") + call write_dataset(file_id, "path", path_input) ! Write out random number seed - call sp % write_data(seed, "seed") + call write_dataset(file_id, "seed", seed) ! Write run information - call sp % write_data(run_mode, "run_mode") - call sp % write_data(n_particles, "n_particles") - call sp % write_data(n_batches, "n_batches") + call write_dataset(file_id, "run_mode", run_mode) + call write_dataset(file_id, "n_particles", n_particles) + call write_dataset(file_id, "n_batches", n_batches) ! Write out current batch number - call sp % write_data(current_batch, "current_batch") + call write_dataset(file_id, "current_batch", current_batch) ! Indicate whether source bank is stored in statepoint if (source_separate) then - call sp % write_data(0, "source_present") + call write_dataset(file_id, "source_present", 0) else - call sp % write_data(1, "source_present") + call write_dataset(file_id, "source_present", 1) end if ! Write out information for eigenvalue run if (run_mode == MODE_EIGENVALUE) then - call sp % write_data(n_inactive, "n_inactive") - call sp % write_data(gen_per_batch, "gen_per_batch") - call sp % write_data(k_generation, "k_generation", & - length=current_batch*gen_per_batch) - call sp % write_data(entropy, "entropy", & - length=current_batch*gen_per_batch) - call sp % write_data(k_col_abs, "k_col_abs") - call sp % write_data(k_col_tra, "k_col_tra") - call sp % write_data(k_abs_tra, "k_abs_tra") - call sp % write_data(k_combined, "k_combined", length=2) + call write_dataset(file_id, "n_inactive", n_inactive) + call write_dataset(file_id, "gen_per_batch", gen_per_batch) + call write_dataset(file_id, "k_generation", k_generation) + call write_dataset(file_id, "entropy", entropy) + call write_dataset(file_id, "k_col_abs", k_col_abs) + call write_dataset(file_id, "k_col_tra", k_col_tra) + call write_dataset(file_id, "k_abs_tra", k_abs_tra) + call write_dataset(file_id, "k_combined", k_combined) ! Write out CMFD info if (cmfd_on) then - call sp % open_group("cmfd") - call sp % close_group() - call sp % write_data(1, "cmfd_on") - call sp % write_data(cmfd % indices, "indices", length=4, group="cmfd") - call sp % write_data(cmfd % k_cmfd, "k_cmfd", length=current_batch, & - group="cmfd") - call sp % write_data(cmfd % cmfd_src, "cmfd_src", & - length=(/cmfd % indices(4), cmfd % indices(1), & - cmfd % indices(2), cmfd % indices(3)/), & - group="cmfd") - call sp % write_data(cmfd % entropy, "cmfd_entropy", & - length=current_batch, group="cmfd") - call sp % write_data(cmfd % balance, "cmfd_balance", & - length=current_batch, group="cmfd") - call sp % write_data(cmfd % dom, "cmfd_dominance", & - length = current_batch, group="cmfd") - call sp % write_data(cmfd % src_cmp, "cmfd_srccmp", & - length = current_batch, group="cmfd") + call write_dataset(file_id, "cmfd_on", 1) + + cmfd_group = create_group(file_id, "cmfd") + call write_dataset(cmfd_group, "indices", cmfd%indices) + call write_dataset(cmfd_group, "k_cmfd", cmfd%k_cmfd) + call write_dataset(cmfd_group, "cmfd_src", cmfd%cmfd_src) + call write_dataset(cmfd_group, "cmfd_entropy", cmfd%entropy) + call write_dataset(cmfd_group, "cmfd_balance", cmfd%balance) + call write_dataset(cmfd_group, "cmfd_dominance", cmfd%dom) + call write_dataset(cmfd_group, "cmfd_srccmp", cmfd%src_cmp) + call close_group(cmfd_group) else - call sp % write_data(0, "cmfd_on") + call write_dataset(file_id, "cmfd_on", 0) end if end if - call sp % open_group("tallies") - call sp % close_group() + tallies_group = create_group(file_id, "tallies") ! Write number of meshes - call sp % write_data(n_meshes, "n_meshes", group="tallies/meshes") + meshes_group = create_group(tallies_group, "meshes") + call write_dataset(meshes_group, "n_meshes", n_meshes) if (n_meshes > 0) then ! Print list of mesh IDs - current => mesh_dict % keys() + current => mesh_dict%keys() allocate(id_array(n_meshes)) allocate(key_array(n_meshes)) i = 1 do while (associated(current)) - key_array(i) = current % key - id_array(i) = current % value + key_array(i) = current%key + id_array(i) = current%value ! Move to next mesh - next => current % next + next => current%next deallocate(current) current => next i = i + 1 end do - call sp % write_data(id_array, "ids", & - group="tallies/meshes", length=n_meshes) - call sp % write_data(key_array, "keys", & - group="tallies/meshes", length=n_meshes) + call write_dataset(meshes_group, "ids", id_array) + call write_dataset(meshes_group, "keys", key_array) deallocate(key_array) ! Write information for meshes MESH_LOOP: do i = 1, n_meshes - mesh => meshes(id_array(i)) + mesh_group = create_group(meshes_group, "mesh " // trim(to_str(mesh%id))) - call sp % write_data(mesh % id, "id", & - group="tallies/meshes/mesh " // trim(to_str(mesh % id))) - call sp % write_data(mesh % type, "type", & - group="tallies/meshes/mesh " // trim(to_str(mesh % id))) - call sp % write_data(mesh % n_dimension, "n_dimension", & - group="tallies/meshes/mesh " // trim(to_str(mesh % id))) - call sp % write_data(mesh % dimension, "dimension", & - group="tallies/meshes/mesh " // trim(to_str(mesh % id)), & - length=mesh % n_dimension) - call sp % write_data(mesh % lower_left, "lower_left", & - group="tallies/meshes/mesh " // trim(to_str(mesh % id)), & - length=mesh % n_dimension) - call sp % write_data(mesh % upper_right, "upper_right", & - group="tallies/meshes/mesh " // trim(to_str(mesh % id)), & - length=mesh % n_dimension) - call sp % write_data(mesh % width, "width", & - group="tallies/meshes/mesh " // trim(to_str(mesh % id)), & - length=mesh % n_dimension) + call write_dataset(mesh_group, "id", mesh%id) + call write_dataset(mesh_group, "type", mesh%type) + call write_dataset(mesh_group, "n_dimension", mesh%n_dimension) + call write_dataset(mesh_group, "dimension", mesh%dimension) + call write_dataset(mesh_group, "lower_left", mesh%lower_left) + call write_dataset(mesh_group, "upper_right", mesh%upper_right) + call write_dataset(mesh_group, "width", mesh%width) + + call close_group(mesh_group) end do MESH_LOOP deallocate(id_array) - end if + call close_group(meshes_group) + ! Write number of tallies - call sp % write_data(n_tallies, "n_tallies", group="tallies") + call write_dataset(tallies_group, "n_tallies", n_tallies) if (n_tallies > 0) then @@ -211,14 +195,12 @@ contains ! Write all tally information except results do i = 1, n_tallies tally => tallies(i) - key_array(i) = tally % id + key_array(i) = tally%id id_array(i) = i end do - call sp % write_data(id_array, "ids", & - group="tallies", length=n_tallies) - call sp % write_data(key_array, "keys", & - group="tallies", length=n_tallies) + call write_dataset(tallies_group, "ids", id_array) + call write_dataset(tallies_group, "keys", key_array) deallocate(key_array) @@ -227,110 +209,92 @@ contains ! Get pointer to tally tally => tallies(i) + tally_group = create_group(tallies_group, "tally " // & + trim(to_str(tally%id))) - call sp % write_data(tally % estimator, "estimator", & - group="tallies/tally " // trim(to_str(tally % id))) - call sp % write_data(tally % n_realizations, "n_realizations", & - group="tallies/tally " // trim(to_str(tally % id))) - call sp % write_data(tally % n_filters, "n_filters", & - group="tallies/tally " // trim(to_str(tally % id))) + call write_dataset(tally_group, "estimator", tally%estimator) + call write_dataset(tally_group, "n_realizations", tally%n_realizations) + call write_dataset(tally_group, "n_filters", tally%n_filters) ! Write filter information - FILTER_LOOP: do j = 1, tally % n_filters + FILTER_LOOP: do j = 1, tally%n_filters + filter_group = create_group(tally_group, "filter " // & + trim(to_str(j))) - call sp % write_data(tally % filters(j) % type, "type", & - group="tallies/tally " // trim(to_str(tally % id)) // & - "/filter " // to_str(j)) - call sp % write_data(tally % filters(j) % offset, "offset", & - group="tallies/tally " // trim(to_str(tally % id)) // & - "/filter " // to_str(j)) - call sp % write_data(tally % filters(j) % n_bins, "n_bins", & - group="tallies/tally " // trim(to_str(tally % id)) // & - "/filter " // to_str(j)) - if (tally % filters(j) % type == FILTER_ENERGYIN .or. & - tally % filters(j) % type == FILTER_ENERGYOUT) then - call sp % write_data(tally % filters(j) % real_bins, "bins", & - group="tallies/tally " // trim(to_str(tally % id)) // & - "/filter " // to_str(j), & - length=size(tally % filters(j) % real_bins)) + call write_dataset(filter_group, "type", tally%filters(j)%type) + call write_dataset(filter_group, "offset", tally%filters(j)%offset) + call write_dataset(filter_group, "n_bins", tally%filters(j)%n_bins) + if (tally%filters(j)%type == FILTER_ENERGYIN .or. & + tally%filters(j)%type == FILTER_ENERGYOUT) then + call write_dataset(filter_group, "bins", & + tally%filters(j)%real_bins) else - call sp % write_data(tally % filters(j) % int_bins, "bins", & - group="tallies/tally " // trim(to_str(tally % id)) // & - "/filter " // to_str(j), & - length=size(tally % filters(j) % int_bins)) + call write_dataset(filter_group, "bins", & + tally%filters(j)%int_bins) end if + call close_group(filter_group) end do FILTER_LOOP - call sp % write_data(tally % n_nuclide_bins, "n_nuclides", & - group="tallies/tally " // trim(to_str(tally % id))) + call write_dataset(tally_group, "n_nuclides", tally%n_nuclide_bins) ! Set up nuclide bin array and then write - allocate(key_array(tally % n_nuclide_bins)) - NUCLIDE_LOOP: do j = 1, tally % n_nuclide_bins - if (tally % nuclide_bins(j) > 0) then - key_array(j) = nuclides(tally % nuclide_bins(j)) % zaid + allocate(key_array(tally%n_nuclide_bins)) + NUCLIDE_LOOP: do j = 1, tally%n_nuclide_bins + if (tally%nuclide_bins(j) > 0) then + key_array(j) = nuclides(tally%nuclide_bins(j))%zaid else - key_array(j) = tally % nuclide_bins(j) + key_array(j) = tally%nuclide_bins(j) end if end do NUCLIDE_LOOP - call sp % write_data(key_array, "nuclides", & - group="tallies/tally " // trim(to_str(tally % id)), & - length=tally % n_nuclide_bins) + call write_dataset(tally_group, "nuclides", key_array) deallocate(key_array) - call sp % write_data(tally % n_score_bins, "n_score_bins", & - group="tallies/tally " // trim(to_str(tally % id))) - call sp % write_data(tally % score_bins, "score_bins", & - group="tallies/tally " // trim(to_str(tally % id)), & - length=tally % n_score_bins) - call sp % write_data(tally % n_user_score_bins, "n_user_score_bins", & - group="tallies/tally " // to_str(tally % id)) + call write_dataset(tally_group, "n_score_bins", tally%n_score_bins) + call write_dataset(tally_group, "score_bins", tally%score_bins) + call write_dataset(tally_group, "n_user_score_bins", tally%n_user_score_bins) ! Write explicit moment order strings for each score bin + moments_group = create_group(tally_group, "moments") k = 1 - MOMENT_LOOP: do j = 1, tally % n_user_score_bins - select case(tally % score_bins(k)) + MOMENT_LOOP: do j = 1, tally%n_user_score_bins + select case(tally%score_bins(k)) case (SCORE_SCATTER_N, SCORE_NU_SCATTER_N) - moment_name = 'P' // trim(to_str(tally % moment_order(k))) - call sp % write_data(moment_name, "order" // trim(to_str(k)), & - group="tallies/tally " // trim(to_str(tally % id)) // & - "/moments") + moment_name = 'P' // trim(to_str(tally%moment_order(k))) + call write_dataset(moments_group, "order" // trim(to_str(k)), moment_name) k = k + 1 case (SCORE_SCATTER_PN, SCORE_NU_SCATTER_PN) - do n_order = 0, tally % moment_order(k) + do n_order = 0, tally%moment_order(k) moment_name = 'P' // trim(to_str(n_order)) - call sp % write_data(moment_name, "order" // trim(to_str(k)), & - group="tallies/tally " // trim(to_str(tally % id)) // & - "/moments") + call write_dataset(moments_group, "order" // trim(to_str(k)), moment_name) k = k + 1 end do case (SCORE_SCATTER_YN, SCORE_NU_SCATTER_YN, SCORE_FLUX_YN, & SCORE_TOTAL_YN) - do n_order = 0, tally % moment_order(k) + do n_order = 0, tally%moment_order(k) do nm_order = -n_order, n_order moment_name = 'Y' // trim(to_str(n_order)) // ',' // & trim(to_str(nm_order)) - call sp % write_data(moment_name, "order" // & - trim(to_str(k)), & - group="tallies/tally " // trim(to_str(tally % id)) // & - "/moments") + call write_dataset(moments_group, "order" // & + trim(to_str(k)), moment_name) k = k + 1 end do end do case default moment_name = '' - call sp % write_data(moment_name, "order" // trim(to_str(k)), & - group="tallies/tally " // trim(to_str(tally % id)) // & - "/moments") + call write_dataset(moments_group, "order" // trim(to_str(k)), & + moment_name) k = k + 1 end select - end do MOMENT_LOOP + call close_group(moments_group) + call close_group(tally_group) end do TALLY_METADATA end if + + call close_group(tallies_group) end if ! Check for the no-tally-reduction method @@ -338,47 +302,41 @@ contains ! 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() + call write_tally_results_nr(file_id) elseif (master) then ! Write number of global realizations - call sp % write_data(n_realizations, "n_realizations") + call write_dataset(file_id, "n_realizations", n_realizations) ! Write global tallies - call sp % write_data(N_GLOBAL_TALLIES, "n_global_tallies") - call sp % write_tally_result(global_tallies, "global_tallies", & - n1=N_GLOBAL_TALLIES, n2=1) + call write_dataset(file_id, "n_global_tallies", N_GLOBAL_TALLIES) + call write_dataset(file_id, "global_tallies", global_tallies) ! Write tallies + tallies_group = open_group(file_id, "tallies") if (tallies_on) then - ! Indicate that tallies are on - call sp % write_data(1, "tallies_present", group="tallies") + call write_dataset(tallies_group, "tallies_present", 1) ! Write all tally results TALLY_RESULTS: do i = 1, n_tallies - ! Set point to current tally tally => tallies(i) ! Write sum and sum_sq for each bin - call sp % write_tally_result(tally % results, "results", & - group="tallies/tally " // trim(to_str(tally % id)), & - n1=size(tally % results, 1), n2=size(tally % results, 2)) - + tally_group = open_group(tallies_group, "tally " // to_str(tally%id)) + call write_dataset(tally_group, "results", tally%results) + call close_group(tally_group) end do TALLY_RESULTS else - ! Indicate tallies are off - call sp % write_data(0, "tallies_present", group="tallies") - + call write_dataset(tallies_group, "tallies_present", 0) end if - ! Close the file for serial writing - call sp % file_close() - + call close_group(tallies_group) + call file_close(file_id) end if if (master .and. n_tallies > 0) then @@ -393,71 +351,64 @@ contains subroutine write_source_point() - type(BinaryOutput) :: sp + integer(HID_T) :: file_id character(MAX_FILE_LEN) :: filename ! Check to write out source for a specified batch - if (sourcepoint_batch % contains(current_batch)) then + if (sourcepoint_batch%contains(current_batch)) then ! Create or open up file if (source_separate) then - ! Set filename filename = trim(path_output) // 'source.' // & & zero_padded(current_batch, count_digits(n_max_batches)) - filename = trim(filename) // '.h5' ! Write message for new file creation call write_message("Creating source file " // trim(filename) // "...", & - &1) + 1) ! Create separate source file - call sp % file_create(filename, serial = .false.) + file_id = file_create(filename, parallel=.true.) ! Write file type - call sp % write_data(FILETYPE_SOURCE, "filetype") - + call write_dataset(file_id, "filetype", FILETYPE_SOURCE) else - ! Set filename for state point filename = trim(path_output) // 'statepoint.' // & zero_padded(current_batch, count_digits(n_max_batches)) filename = trim(filename) // '.h5' ! Reopen statepoint file in parallel - call sp % file_open(filename, 'w', serial = .false.) - + file_id = file_open(filename, 'w', parallel=.true.) end if ! Write out source - call sp % write_source_bank() + call write_source_bank(file_id) ! Close file - call sp % file_close() - + call file_close(file_id) end if ! Also check to write source separately in overwritten file if (source_latest) then ! Set filename - filename = trim(path_output) // 'source' - filename = trim(filename) // '.h5' + filename = trim(path_output) // 'source' // '.h5' ! Write message for new file creation call write_message("Creating source file " // trim(filename) // "...", 1) ! Always create this file because it will be overwritten - call sp % file_create(filename, serial = .false.) + file_id = file_create(filename, parallel=.true.) ! Write file type - call sp % write_data(FILETYPE_SOURCE, "filetype") + call write_dataset(file_id, "filetype", FILETYPE_SOURCE) ! Write out source - call sp % write_source_bank() + call write_source_bank(file_id) ! Close file - call sp % file_close() + call file_close(file_id) end if @@ -467,12 +418,14 @@ contains ! WRITE_TALLY_RESULTS_NR !=============================================================================== - subroutine write_tally_results_nr() + subroutine write_tally_results_nr(file_id) + integer(HID_T), intent(in) :: file_id integer :: i ! loop index integer :: n ! number of filter bins integer :: m ! number of score bins integer :: n_bins ! total number of bins + integer(HID_T) :: tallies_group, tally_group real(8), allocatable :: tally_temp(:,:,:) ! contiguous array of results real(8), target :: global_temp(2,N_GLOBAL_TALLIES) #ifdef MPI @@ -489,16 +442,18 @@ contains if (master) then ! Write number of realizations - call sp % write_data(n_realizations, "n_realizations") + call write_dataset(file_id, "n_realizations", n_realizations) ! Write number of global tallies - call sp % write_data(N_GLOBAL_TALLIES, "n_global_tallies") + call write_dataset(file_id, "n_global_tallies", N_GLOBAL_TALLIES) + + tallies_group = open_group(file_id, "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 + 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 @@ -510,19 +465,17 @@ contains ! Transfer values to value on master if (current_batch == n_max_batches .or. satisfy_triggers) then - global_tallies(:) % sum = global_temp(1,:) - global_tallies(:) % sum_sq = global_temp(2,:) + 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,:) - + tallyresult_temp(:,1)%sum = global_temp(1,:) + tallyresult_temp(:,1)%sum_sq = global_temp(2,:) ! Write out global tallies sum and sum_sq - call sp % write_tally_result(tallyresult_temp, "global_tallies", & - n1=N_GLOBAL_TALLIES, n2=1) + call write_dataset(file_id, "global_tallies", tallyresult_temp) ! Deallocate temporary tally result deallocate(tallyresult_temp) @@ -537,17 +490,17 @@ contains if (tallies_on) then ! Indicate that tallies are on if (master) then - call sp % write_data(1, "tallies_present", group="tallies") + call write_dataset(tallies_group, "tallies_present", 1) ! Build list of tally IDs - current => tally_dict % keys() + current => tally_dict%keys() allocate(id_array(n_tallies)) i = 1 do while (associated(current)) - id_array(i) = current % value + id_array(i) = current%value ! Move to next tally - next => current % next + next => current%next deallocate(current) current => next i = i + 1 @@ -561,17 +514,20 @@ contains tally => tallies(i) ! Determine size of tally results array - m = size(tally % results, 1) - n = size(tally % results, 2) + m = size(tally%results, 1) + n = size(tally%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,:,:) = tally % results(:,:) % sum - tally_temp(2,:,:) = tally % results(:,:) % sum_sq + tally_temp(1,:,:) = tally%results(:,:)%sum + tally_temp(2,:,:) = tally%results(:,:)%sum_sq if (master) then + tally_group = open_group(tallies_group, "tally " // & + trim(to_str(tally%id))) + ! The MPI_IN_PLACE specifier allows the master to copy values into ! a receive buffer without having a temporary variable #ifdef MPI @@ -582,18 +538,17 @@ contains ! At the end of the simulation, store the results back in the ! regular TallyResults array if (current_batch == n_max_batches .or. satisfy_triggers) then - tally % results(:,:) % sum = tally_temp(1,:,:) - tally % results(:,:) % sum_sq = tally_temp(2,:,:) + tally%results(:,:)%sum = tally_temp(1,:,:) + tally%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,:,:) + tallyresult_temp(:,:)%sum = tally_temp(1,:,:) + tallyresult_temp(:,:)%sum_sq = tally_temp(2,:,:) ! Write reduced tally results to file - call sp % write_tally_result(tally % results, "results", & - group="tallies/tally " // trim(to_str(tally % id)), n1=m, n2=n) + call write_dataset(tally_group, "results", tally%results) ! Deallocate temporary tally result deallocate(tallyresult_temp) @@ -607,6 +562,8 @@ contains ! Deallocate temporary copy of tally results deallocate(tally_temp) + + if (master) call close_group(tally_group) end do TALLY_RESULTS deallocate(id_array) @@ -614,10 +571,12 @@ contains else if (master) then ! Indicate that tallies are off - call sp % write_data(0, "tallies_present", group="tallies") + call write_dataset(tallies_group, "tallies_present", 0) end if end if + if (master) call close_group(tallies_group) + end subroutine write_tally_results_nr !=============================================================================== @@ -626,45 +585,49 @@ contains subroutine load_state_point() - character(MAX_FILE_LEN) :: path_temp - character(19) :: current_time integer :: i, j, k - integer :: length(4) integer :: int_array(3) - integer, allocatable :: id_array(:) - integer, allocatable :: key_array(:) integer :: curr_key - integer, allocatable :: temp_array(:) - logical :: source_present - real(8) :: real_array(3) - type(StructuredMesh), pointer :: mesh - type(TallyObject), pointer :: tally integer :: n_order ! loop index for moment orders integer :: nm_order ! loop index for Ynm moment orders + integer, allocatable :: id_array(:) + integer, allocatable :: key_array(:) + integer, allocatable :: temp_array(:) + integer(HID_T) :: file_id + integer(HID_T) :: cmfd_group + integer(HID_T) :: tallies_group, tally_group + integer(HID_T) :: meshes_group, mesh_group + integer(HID_T) :: filter_group, moments_group + real(8) :: real_array(3) + logical :: source_present + character(MAX_FILE_LEN) :: path_temp + character(19) :: current_time character(8) :: moment_name ! name of moment (e.g, P3, Y-1,1) + type(StructuredMesh), pointer :: mesh + type(TallyObject), pointer :: tally ! Write message call write_message("Loading state point " // trim(path_state_point) & - &// "...", 1) + // "...", 1) ! Open file for reading - call sp % file_open(path_state_point, 'r', serial = .false.) + file_id = file_open(path_state_point, 'r', parallel=.true.) ! Read filetype - call sp % read_data(int_array(1), "filetype") + call read_dataset(file_id, "filetype", int_array(1)) ! Read revision number for state point file and make sure it matches with ! current version - call sp % read_data(int_array(1), "revision") + call read_dataset(file_id, "revision", int_array(1)) if (int_array(1) /= REVISION_STATEPOINT) then call fatal_error("State point version does not match current version & &in OpenMC.") end if ! Read OpenMC version - call sp % read_data(int_array(1), "version_major") - call sp % read_data(int_array(2), "version_minor") - call sp % read_data(int_array(3), "version_release") + call read_dataset(file_id, "version_major", int_array(1)) + call read_dataset(file_id, "version_minor", int_array(2)) + call read_dataset(file_id, "version_release", int_array(3)) if (int_array(1) /= VERSION_MAJOR .or. int_array(2) /= VERSION_MINOR & .or. int_array(3) /= VERSION_RELEASE) then if (master) call warning("State point file was created with a different & @@ -672,27 +635,27 @@ contains end if ! Read date and time - call sp % read_data(current_time, "date_and_time") + call read_dataset(file_id, "date_and_time", current_time) ! Read path to input - call sp % read_data(path_temp, "path") + call read_dataset(file_id, "path", path_temp) ! Read and overwrite random number seed - call sp % read_data(seed, "seed") + call read_dataset(file_id, "seed", seed) ! Read and overwrite run information except number of batches - call sp % read_data(run_mode, "run_mode") - call sp % read_data(n_particles, "n_particles") - call sp % read_data(int_array(1), "n_batches") + call read_dataset(file_id, "run_mode", run_mode) + call read_dataset(file_id, "n_particles", n_particles) + call read_dataset(file_id, "n_batches", int_array(1)) ! 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 sp % read_data(restart_batch, "current_batch") + call read_dataset(file_id, "current_batch", restart_batch) ! Check for source in statepoint if needed - call sp % read_data(int_array(1), "source_present") + call read_dataset(file_id, "source_present", int_array(1)) if (int_array(1) == 1) then source_present = .true. else @@ -706,43 +669,45 @@ contains ! Read information specific to eigenvalue run if (run_mode == MODE_EIGENVALUE) then - call sp % read_data(int_array(1), "n_inactive") - call sp % read_data(gen_per_batch, "gen_per_batch") - call sp % read_data(k_generation, "k_generation", & - length=restart_batch*gen_per_batch) - call sp % read_data(entropy, "entropy", length=restart_batch*gen_per_batch) - call sp % read_data(k_col_abs, "k_col_abs") - call sp % read_data(k_col_tra, "k_col_tra") - call sp % read_data(k_abs_tra, "k_abs_tra") - call sp % read_data(real_array(1:2), "k_combined", length=2) + call read_dataset(file_id, "n_inactive", int_array(1)) + call read_dataset(file_id, "gen_per_batch", gen_per_batch) + call read_dataset(file_id, "k_generation", & + k_generation(1:restart_batch*gen_per_batch)) + call read_dataset(file_id, "entropy", & + entropy(1:restart_batch*gen_per_batch)) + call read_dataset(file_id, "k_col_abs", k_col_abs) + call read_dataset(file_id, "k_col_tra", k_col_tra) + call read_dataset(file_id, "k_abs_tra", k_abs_tra) + call read_dataset(file_id, "k_combined", real_array(1:2)) ! Take maximum of statepoint n_inactive and input n_inactive n_inactive = max(n_inactive, int_array(1)) ! Read in to see if CMFD was on - call sp % read_data(int_array(1), "cmfd_on") + call read_dataset(file_id, "cmfd_on", int_array(1)) ! Read in CMFD info if (int_array(1) == 1) then - call sp % read_data(cmfd % indices, "indices", length=4, group="cmfd") - call sp % read_data(cmfd % k_cmfd, "k_cmfd", length=restart_batch, & - group="cmfd") - length = cmfd % indices([4,1,2,3]) - call sp % read_data(cmfd % cmfd_src, "cmfd_src", & - length=length, group="cmfd") - call sp % read_data(cmfd % entropy, "cmfd_entropy", & - length=restart_batch, group="cmfd") - call sp % read_data(cmfd % balance, "cmfd_balance", & - length=restart_batch, group="cmfd") - call sp % read_data(cmfd % dom, "cmfd_dominance", & - length = restart_batch, group="cmfd") - call sp % read_data(cmfd % src_cmp, "cmfd_srccmp", & - length = restart_batch, group="cmfd") + cmfd_group = open_group(file_id, "cmfd") + call read_dataset(cmfd_group, "indices", cmfd%indices) + call read_dataset(cmfd_group, "k_cmfd", cmfd%k_cmfd(1:restart_batch)) + call read_dataset(cmfd_group, "cmfd_src", cmfd%cmfd_src) + call read_dataset(cmfd_group, "cmfd_entropy", & + cmfd%entropy(1:restart_batch)) + call read_dataset(cmfd_group, "cmfd_balance", & + cmfd%balance(1:restart_batch)) + call read_dataset(cmfd_group, "cmfd_dominance", & + cmfd%dom(1:restart_batch)) + call read_dataset(cmfd_group, "cmfd_srccmp", & + cmfd%src_cmp(1:restart_batch)) + call close_group(cmfd_group) end if end if ! Read number of meshes - call sp % read_data(n_meshes, "n_meshes", group="tallies/meshes") + tallies_group = open_group(file_id, "tallies") + meshes_group = open_group(tallies_group, "meshes") + call read_dataset(meshes_group, "n_meshes", n_meshes) if (n_meshes > 0) then @@ -750,10 +715,8 @@ contains allocate(id_array(n_meshes)) allocate(key_array(n_meshes)) - call sp % read_data(id_array, "ids", & - group="tallies/meshes", length=n_meshes) - call sp % read_data(key_array, "keys", & - group="tallies/meshes", length=n_meshes) + call read_dataset(meshes_group, "ids", id_array) + call read_dataset(meshes_group, "keys", key_array) ! Read and overwrite mesh information MESH_LOOP: do i = 1, n_meshes @@ -761,25 +724,16 @@ contains mesh => meshes(id_array(i)) curr_key = key_array(id_array(i)) - call sp % read_data(mesh % id, "id", & - group="tallies/meshes/mesh " // trim(to_str(curr_key))) - call sp % read_data(mesh % type, "type", & - group="tallies/meshes/mesh " // trim(to_str(curr_key))) - call sp % read_data(mesh % n_dimension, "n_dimension", & - group="tallies/meshes/mesh " // trim(to_str(meshes(i) % id))) - call sp % read_data(mesh % dimension, "dimension", & - group="tallies/meshes/mesh " // trim(to_str(curr_key)), & - length=mesh % n_dimension) - call sp % read_data(mesh % lower_left, "lower_left", & - group="tallies/meshes/mesh " // trim(to_str(curr_key)), & - length=mesh % n_dimension) - call sp % read_data(mesh % upper_right, "upper_right", & - group="tallies/meshes/mesh " // trim(to_str(curr_key)), & - length=mesh % n_dimension) - call sp % read_data(mesh % width, "width", & - group="tallies/meshes/mesh " // trim(to_str(curr_key)), & - length=meshes(i) % n_dimension) - + mesh_group = open_group(meshes_group, "mesh " // & + trim(to_str(curr_key))) + call read_dataset(mesh_group, "id", mesh%id) + call read_dataset(mesh_group, "type", mesh%type) + call read_dataset(mesh_group, "n_dimension", mesh%n_dimension) + call read_dataset(mesh_group, "dimension", mesh%dimension) + call read_dataset(mesh_group, "lower_left", mesh%lower_left) + call read_dataset(mesh_group, "upper_right", mesh%upper_right) + call read_dataset(mesh_group, "width", mesh%width) + call close_group(mesh_group) end do MESH_LOOP deallocate(id_array) @@ -787,15 +741,17 @@ contains end if + call close_group(meshes_group) + ! Read and overwrite number of tallies - call sp % read_data(n_tallies, "n_tallies", group="tallies") + call read_dataset(tallies_group, "n_tallies", n_tallies) ! Read list of tally keys-> IDs allocate(id_array(n_tallies)) allocate(key_array(n_tallies)) - call sp % read_data(id_array, "ids", group="tallies", length=n_tallies) - call sp % read_data(key_array, "keys", group="tallies", length=n_tallies) + call read_dataset(tallies_group, "ids", id_array) + call read_dataset(tallies_group, "keys", key_array) ! Read in tally metadata TALLY_METADATA: do i = 1, n_tallies @@ -803,99 +759,85 @@ contains ! Get pointer to tally tally => tallies(i) curr_key = key_array(id_array(i)) + tally_group = open_group(tallies_group, "tally " // & + trim(to_str(curr_key))) - call sp % read_data(tally % estimator, "estimator", & - group="tallies/tally " // trim(to_str(curr_key))) - call sp % read_data(tally % n_realizations, "n_realizations", & - group="tallies/tally " // trim(to_str(curr_key))) - call sp % read_data(tally % n_filters, "n_filters", & - group="tallies/tally " // trim(to_str(curr_key))) + call read_dataset(tally_group, "estimator", tally%estimator) + call read_dataset(tally_group, "n_realizations", tally%n_realizations) + call read_dataset(tally_group, "n_filters", tally%n_filters) - FILTER_LOOP: do j = 1, tally % n_filters - call sp % read_data(tally % filters(j) % type, "type", & - group="tallies/tally " // trim(to_str(curr_key)) // & - "/filter " // to_str(j)) - call sp % read_data(tally % filters(j) % offset, "offset", & - group="tallies/tally " // trim(to_str(curr_key)) // & - "/filter " // to_str(j)) - call sp % read_data(tally % filters(j) % n_bins, "n_bins", & - group="tallies/tally " // trim(to_str(curr_key)) // & - "/filter " // to_str(j)) - if (tally % filters(j) % type == FILTER_ENERGYIN .or. & - tally % filters(j) % type == FILTER_ENERGYOUT) then - call sp % read_data(tally % filters(j) % real_bins, "bins", & - group="tallies/tally " // trim(to_str(curr_key)) // & - "/filter " // to_str(j), & - length=size(tally % filters(j) % real_bins)) + FILTER_LOOP: do j = 1, tally%n_filters + filter_group = open_group(tally_group, "filter " // trim(to_str(j))) + + call read_dataset(filter_group, "type", tally%filters(j)%type) + call read_dataset(filter_group, "offset", tally%filters(j)%offset) + call read_dataset(filter_group, "n_bins", tally%filters(j)%n_bins) + if (tally%filters(j)%type == FILTER_ENERGYIN .or. & + tally%filters(j)%type == FILTER_ENERGYOUT) then + call read_dataset(filter_group, "bins", tally%filters(j)%real_bins) else - call sp % read_data(tally % filters(j) % int_bins, "bins", & - group="tallies/tally " // trim(to_str(curr_key)) // & - "/filter " // to_str(j), & - length=size(tally % filters(j) % int_bins)) + call read_dataset(filter_group, "bins", tally%filters(j)%int_bins) end if + call close_group(filter_group) end do FILTER_LOOP - call sp % read_data(tally % n_nuclide_bins, "n_nuclides", & - group="tallies/tally " // trim(to_str(curr_key))) + call read_dataset(tally_group, "n_nuclides", tally%n_nuclide_bins) ! Set up nuclide bin array and then read - allocate(temp_array(tally % n_nuclide_bins)) - call sp % read_data(temp_array, "nuclides", & - group="tallies/tally " // trim(to_str(curr_key)), & - length=tally % n_nuclide_bins) + allocate(temp_array(tally%n_nuclide_bins)) + call read_dataset(tally_group, "nuclides", temp_array) - NUCLIDE_LOOP: do j = 1, tally % n_nuclide_bins + NUCLIDE_LOOP: do j = 1, tally%n_nuclide_bins if (temp_array(j) > 0) then - tally % nuclide_bins(j) = temp_array(j) + tally%nuclide_bins(j) = temp_array(j) else - tally % nuclide_bins(j) = temp_array(j) + tally%nuclide_bins(j) = temp_array(j) end if end do NUCLIDE_LOOP deallocate(temp_array) ! Write number of score bins, score bins, user score bins - call sp % read_data(tally % n_score_bins, "n_score_bins", & - group="tallies/tally " // trim(to_str(curr_key))) - call sp % read_data(tally % score_bins, "score_bins", & - group="tallies/tally " // trim(to_str(curr_key)), & - length=tally % n_score_bins) - call sp % read_data(tally % n_user_score_bins, "n_user_score_bins", & - group="tallies/tally " // trim(to_str(curr_key))) + call read_dataset(tally_group, "n_score_bins", tally%n_score_bins) + call read_dataset(tally_group, "score_bins", tally%score_bins) + call read_dataset(tally_group, "n_user_score_bins", tally%n_user_score_bins) ! Read explicit moment order strings for each score bin k = 1 - MOMENT_LOOP: do j = 1, tally % n_user_score_bins - select case(tally % score_bins(k)) + moments_group = open_group(tally_group, "moments") + MOMENT_LOOP: do j = 1, tally%n_user_score_bins + select case(tally%score_bins(k)) case (SCORE_SCATTER_N, SCORE_NU_SCATTER_N) - call sp % read_data(moment_name, "order" // trim(to_str(k)), & - group="tallies/tally " // trim(to_str(curr_key)) // "/moments") + call read_dataset(moments_group, "order" // trim(to_str(k)), & + moment_name) k = k + 1 case (SCORE_SCATTER_PN, SCORE_NU_SCATTER_PN) - do n_order = 0, tally % moment_order(k) - call sp % read_data(moment_name, "order" // trim(to_str(k)), & - group="tallies/tally " // trim(to_str(curr_key)) // "/moments") + do n_order = 0, tally%moment_order(k) + call read_dataset(moments_group, "order" // trim(to_str(k)), & + moment_name) k = k + 1 end do case (SCORE_SCATTER_YN, SCORE_NU_SCATTER_YN, SCORE_FLUX_YN, & SCORE_TOTAL_YN) - do n_order = 0, tally % moment_order(k) + do n_order = 0, tally%moment_order(k) do nm_order = -n_order, n_order - call sp % read_data(moment_name, "order" // trim(to_str(k)), & - group="tallies/tally " // trim(to_str(curr_key)) // & - "/moments") + call read_dataset(moments_group, "order" // trim(to_str(k)), & + moment_name) k = k + 1 end do end do case default - call sp % read_data(moment_name, "order" // trim(to_str(k)), & - group="tallies/tally " // trim(to_str(curr_key)) // "/moments") + call read_dataset(moments_group, "order" // trim(to_str(k)), & + moment_name) k = k + 1 end select end do MOMENT_LOOP + call close_group(moments_group) + call close_group(tally_group) + end do TALLY_METADATA ! Check to make sure source bank is present @@ -908,22 +850,21 @@ contains if (master) then ! Read number of realizations for global tallies - call sp % read_data(n_realizations, "n_realizations", collect=.false.) + call read_dataset(file_id, "n_realizations", n_realizations, indep=.true.) ! Read number of global tallies - call sp % read_data(int_array(1), "n_global_tallies", collect=.false.) + call read_dataset(file_id, "n_global_tallies", int_array(1), indep=.false.) if (int_array(1) /= N_GLOBAL_TALLIES) then call fatal_error("Number of global tallies does not match in state & &point.") end if ! Read global tally data - call sp % read_tally_result(global_tallies, "global_tallies", & - n1=N_GLOBAL_TALLIES, n2=1) + call read_dataset(file_id, "global_tallies", global_tallies) ! Check if tally results are present - call sp % read_data(int_array(1), "tallies_present", & - group="tallies", collect=.false.) + tallies_group = open_group(file_id, "tallies") + call read_dataset(file_id, "tallies_present", int_array(1), indep=.true.) ! Read in sum and sum squared if (int_array(1) == 1) then @@ -934,13 +875,14 @@ contains curr_key = key_array(id_array(i)) ! Read sum and sum_sq for each bin - call sp % read_tally_result(tally % results, "results", & - group="tallies/tally " // trim(to_str(curr_key)), & - n1=size(tally % results, 1), n2=size(tally % results, 2)) - + tally_group = open_group(tallies_group, "tally " // & + trim(to_str(curr_key))) + call read_dataset(tally_group, "results", tally%results) + call close_group(tally_group) end do TALLY_RESULTS - end if + + call close_group(tallies_group) end if deallocate(id_array) @@ -953,30 +895,186 @@ contains if (.not. source_present) then ! Close statepoint file - call sp % file_close() + call file_close(file_id) ! Write message call write_message("Loading source file " // trim(path_source_point) & - &// "...", 1) + // "...", 1) ! Open source file - call sp % file_open(path_source_point, 'r', serial = .false.) + file_id = file_open(path_source_point, 'r', parallel=.true.) ! Read file type - call sp % read_data(int_array(1), "filetype") + call read_dataset(file_id, "filetype", int_array(1)) end if ! Write out source - call sp % read_source_bank() + call read_source_bank(file_id) end if ! Close file - call sp % file_close() + call file_close(file_id) end subroutine load_state_point +!=============================================================================== +! WRITE_SOURCE_BANK writes OpenMC source_bank data +!=============================================================================== + + subroutine write_source_bank(group_id) + use bank_header, only: Bank + + integer(HID_T), intent(in) :: group_id + + integer :: hdf5_err + integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data or file space handle + integer(HSIZE_T) :: dims(1) + type(c_ptr) :: f_ptr +#ifdef PHDF5 + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: memspace ! memory space handle + integer(HSIZE_T) :: offset(1) ! source data offset +#endif + +#ifdef PHDF5 + ! Set size of total dataspace for all procs and rank + dims(1) = n_particles + call h5screate_simple_f(1, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, "source_bank", hdf5_bank_t, dspace, dset, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + + ! Create another data space but for each proc individually + dims(1) = work + call h5screate_simple_f(1, 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) = work_index(rank) + 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) + + ! 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 + + ! Set size + dims(1) = work + + ! Create dataspace + call h5screate_simple_f(1, dims, dspace, hdf5_err) + + ! Create dataset + call h5dcreate_f(group_id, "source_bank", hdf5_bank_t, & + dspace, dset, hdf5_err) + + ! Set up pointer to data + f_ptr = c_loc(source_bank) + + ! 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 + + end subroutine write_source_bank + +!=============================================================================== +! READ_SOURCE_BANK reads OpenMC source_bank data +!=============================================================================== + + subroutine read_source_bank(group_id) + use bank_header, only: Bank + + integer(HID_T), intent(in) :: group_id + + integer :: hdf5_err + integer(HID_T) :: dset ! data set handle + type(c_ptr) :: f_ptr +#ifdef PHDF5 + integer :: data_xfer_mode + integer(HID_T) :: plist ! property list + integer(HID_T) :: dspace ! data space handle + integer(HID_T) :: memspace ! memory space handle + integer(HSIZE_T) :: offset(1) ! offset of data + integer(HSIZE_T) :: dims(1) +#endif + +#ifdef PHDF5 + + ! Open the dataset + call h5dopen_f(group_id, "source_bank", dset, hdf5_err) + + ! Create another data space but for each proc individually + dims(1) = work + call h5screate_simple_f(1, 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) = work_index(rank) + 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) + + ! 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 + + ! Open dataset + call h5dopen_f(group_id, "source_bank", dset, hdf5_err) + + ! Set up pointer to data + f_ptr = c_loc(source_bank) + + ! 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 + + end subroutine read_source_bank + subroutine read_source ! TODO write this routine ! TODO what if n_particles does not match source bank diff --git a/src/track_output.F90 b/src/track_output.F90 index d3716e9b0..d4b287800 100644 --- a/src/track_output.F90 +++ b/src/track_output.F90 @@ -6,19 +6,27 @@ module track_output use global - use output_interface, only: BinaryOutput + use hdf5_interface use particle_header, only: Particle use string, only: to_str - implicit none + use hdf5 - type, private :: TrackCoordinates + implicit none + private + + type TrackCoordinates real(8), allocatable :: coords(:,:) end type TrackCoordinates - type(TrackCoordinates), private, allocatable :: tracks(:) + type(TrackCoordinates), allocatable :: tracks(:) !$omp threadprivate(tracks) + public :: initialize_particle_track + public :: write_particle_track + public :: add_particle_track + public :: finalize_particle_track + contains !=============================================================================== @@ -43,19 +51,19 @@ contains ! Add another column to coords i = size(tracks) - if (allocated(tracks(i) % coords)) then - n_tracks = size(tracks(i) % coords, 2) + if (allocated(tracks(i)%coords)) then + n_tracks = size(tracks(i)%coords, 2) allocate(new_coords(3, n_tracks + 1)) - new_coords(:, 1:n_tracks) = tracks(i) % coords - call move_alloc(FROM=new_coords, TO=tracks(i) % coords) + new_coords(:, 1:n_tracks) = tracks(i)%coords + call move_alloc(FROM=new_coords, TO=tracks(i)%coords) else n_tracks = 0 - allocate(tracks(i) % coords(3, 1)) + allocate(tracks(i)%coords(3, 1)) end if ! Write current coordinates into the newest column. n_tracks = n_tracks + 1 - tracks(i) % coords(:, n_tracks) = p % coord(1) % xyz + tracks(i)%coords(:, n_tracks) = p%coord(1)%xyz end subroutine write_particle_track !=============================================================================== @@ -87,35 +95,32 @@ contains subroutine finalize_particle_track(p) type(Particle), intent(in) :: p - integer :: length(2) - character(MAX_FILE_LEN) :: fname - type(BinaryOutput) :: binout - integer :: i - integer, allocatable :: n_coords(:) integer :: n_particle_tracks + integer(HID_T) :: file_id + character(MAX_FILE_LEN) :: fname + integer, allocatable :: n_coords(:) fname = trim(path_output) // 'track_' // trim(to_str(current_batch)) & - // '_' // trim(to_str(current_gen)) // '_' // trim(to_str(p % id)) & + // '_' // trim(to_str(current_gen)) // '_' // trim(to_str(p%id)) & // '.h5' ! Determine total number of particles and number of coordinates for each n_particle_tracks = size(tracks) allocate(n_coords(n_particle_tracks)) do i = 1, n_particle_tracks - n_coords(i) = size(tracks(i) % coords, 2) + n_coords(i) = size(tracks(i)%coords, 2) end do !$omp critical (FinalizeParticleTrack) - call binout % file_create(fname) - call binout % write_data(n_particle_tracks, 'n_particles') - call binout % write_data(n_coords, 'n_coords', length=n_particle_tracks) + file_id = file_create(fname) + call write_dataset(file_id, 'n_particles', n_particle_tracks) + call write_dataset(file_id, 'n_coords', n_coords) do i = 1, n_particle_tracks - length(:) = [3, n_coords(i)] - call binout % write_data(tracks(i) % coords, 'coordinates_' // & - trim(to_str(i)), length=length) + call write_dataset(file_id, 'coordinates_' // trim(to_str(i)), & + tracks(i)%coords) end do - call binout % file_close() + call file_close(file_id) !$omp end critical (FinalizeParticleTrack) deallocate(tracks) end subroutine finalize_particle_track From 276dba020f87f2ccd6521030f114eb4b95592803 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 4 Sep 2015 12:22:48 +0700 Subject: [PATCH 12/32] Fixes in source bank writing/reading to enable MPI+HDF5 (without PHDF5) --- src/hdf5_interface.F90 | 18 ++--- src/state_point.F90 | 178 ++++++++++++++++++++++------------------- 2 files changed, 104 insertions(+), 92 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 1684c352b..491337e00 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -85,11 +85,10 @@ contains logical :: parallel_ ! Check for serial option - if (present(parallel)) then - parallel_ = parallel - else - parallel_ = .false. - end if + parallel_ = .false. +#ifdef PHDF5 + if (present(parallel)) parallel_ = parallel +#endif if (parallel_) then ! Setup file access property list with parallel I/O access @@ -132,11 +131,10 @@ contains integer :: open_mode ! HDF5 open mode ! Check for serial option - if (present(parallel)) then - parallel_ = parallel - else - parallel_ = .false. - end if + parallel_ = .false. +#ifdef PHDF5 + if (present(parallel)) parallel_ = parallel +#endif ! Determine access type open_mode = H5F_ACC_RDONLY_F diff --git a/src/state_point.F90 b/src/state_point.F90 index 084289bee..aca6fafb7 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -351,65 +351,60 @@ contains subroutine write_source_point() + logical :: parallel integer(HID_T) :: file_id character(MAX_FILE_LEN) :: filename + ! When using parallel HDF5, the file is written to collectively by all + ! processes. With MPI-only, the file is opened and written by the master + ! (note that the call to write_source_bank is by all processes since slave + ! processes need to send source bank data to the master. +#ifdef PHDF5 + parallel = .true. +#else + parallel = .false. +#endif + ! Check to write out source for a specified batch if (sourcepoint_batch%contains(current_batch)) then - - ! Create or open up file if (source_separate) then - ! Set filename filename = trim(path_output) // 'source.' // & & zero_padded(current_batch, count_digits(n_max_batches)) filename = trim(filename) // '.h5' - - ! Write message for new file creation - call write_message("Creating source file " // trim(filename) // "...", & - 1) + call write_message("Creating source file " // trim(filename) & + // "...", 1) ! Create separate source file - file_id = file_create(filename, parallel=.true.) - - ! Write file type - call write_dataset(file_id, "filetype", FILETYPE_SOURCE) + if (master .or. parallel) then + file_id = file_create(filename, parallel=.true.) + call write_dataset(file_id, "filetype", FILETYPE_SOURCE) + end if else - ! Set filename for state point filename = trim(path_output) // 'statepoint.' // & zero_padded(current_batch, count_digits(n_max_batches)) filename = trim(filename) // '.h5' - ! Reopen statepoint file in parallel - file_id = file_open(filename, 'w', parallel=.true.) + if (master .or. parallel) then + file_id = file_open(filename, 'w', parallel=.true.) + end if end if - ! Write out source call write_source_bank(file_id) - - ! Close file - call file_close(file_id) + if (master .or. parallel) call file_close(file_id) end if ! Also check to write source separately in overwritten file if (source_latest) then - ! Set filename filename = trim(path_output) // 'source' // '.h5' - - ! Write message for new file creation call write_message("Creating source file " // trim(filename) // "...", 1) + if (master .or. parallel) then + file_id = file_create(filename, parallel=.true.) + call write_dataset(file_id, "filetype", FILETYPE_SOURCE) + end if - ! Always create this file because it will be overwritten - file_id = file_create(filename, parallel=.true.) - - ! Write file type - call write_dataset(file_id, "filetype", FILETYPE_SOURCE) - - ! Write out source call write_source_bank(file_id) - ! Close file - call file_close(file_id) - + if (master .or. parallel) call file_close(file_id) end if end subroutine write_source_point @@ -931,13 +926,18 @@ contains integer :: hdf5_err integer(HID_T) :: dset ! data set handle integer(HID_T) :: dspace ! data or file space handle + integer(HID_T) :: memspace ! memory space handle + integer(HSIZE_T) :: offset(1) ! source data offset integer(HSIZE_T) :: dims(1) type(c_ptr) :: f_ptr #ifdef PHDF5 integer :: data_xfer_mode integer(HID_T) :: plist ! property list - integer(HID_T) :: memspace ! memory space handle - integer(HSIZE_T) :: offset(1) ! source data offset +#else + integer :: i +#ifdef MPI + type(Bank), allocatable, target :: temp_source(:) +#endif #endif #ifdef PHDF5 @@ -945,15 +945,11 @@ contains dims(1) = n_particles call h5screate_simple_f(1, dims, dspace, hdf5_err) call h5dcreate_f(group_id, "source_bank", hdf5_bank_t, dspace, dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) ! Create another data space but for each proc individually dims(1) = work call h5screate_simple_f(1, 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) = work_index(rank) call h5sselect_hyperslab_f(dspace, H5S_SELECT_SET_F, offset, dims, hdf5_err) @@ -978,25 +974,60 @@ contains #else - ! Set size - dims(1) = work + if (master) then + ! Create dataset big enough to hold all source sites + dims(1) = n_particles + call h5screate_simple_f(1, dims, dspace, hdf5_err) + call h5dcreate_f(group_id, "source_bank", hdf5_bank_t, & + dspace, dset, hdf5_err) - ! Create dataspace - call h5screate_simple_f(1, dims, dspace, hdf5_err) + ! Save source bank sites since the souce_bank array is overwritten below +#ifdef MPI + allocate(temp_source(work)) + temp_source(:) = source_bank(:) +#endif - ! Create dataset - call h5dcreate_f(group_id, "source_bank", hdf5_bank_t, & - dspace, dset, hdf5_err) + do i = 0, n_procs - 1 + ! Create memory space + dims(1) = work_index(i+1) - work_index(i) + call h5screate_simple_f(1, dims, memspace, hdf5_err) - ! Set up pointer to data - f_ptr = c_loc(source_bank) +#ifdef MPI + ! Receive source sites from other processes + if (i > 0) then + call MPI_RECV(source_bank, int(dims(1)), MPI_BANK, i, i, & + MPI_COMM_WORLD, MPI_STATUS_IGNORE, mpi_err) + end if +#endif - ! Write dataset to file - call h5dwrite_f(dset, hdf5_bank_t, f_ptr, hdf5_err) + ! Select hyperslab for this dataspace + call h5dget_space_f(dset, dspace, hdf5_err) + offset(1) = work_index(i) + call h5sselect_hyperslab_f(dspace, H5S_SELECT_SET_F, offset, dims, hdf5_err) - ! Close all ids - call h5dclose_f(dset, hdf5_err) - call h5sclose_f(dspace, hdf5_err) + ! Set up pointer to data and write data to hyperslab + f_ptr = c_loc(source_bank) + call h5dwrite_f(dset, hdf5_bank_t, f_ptr, hdf5_err, & + file_space_id=dspace, mem_space_id=memspace) + + call h5sclose_f(memspace, hdf5_err) + call h5sclose_f(dspace, hdf5_err) + end do + + ! Close all ids + call h5dclose_f(dset, hdf5_err) + + ! Restore state of source bank +#ifdef MPI + source_bank(:) = temp_source(:) + deallocate(temp_source) +#endif + else +#ifdef MPI + call MPI_SEND(source_bank, int(work), MPI_BANK, 0, rank, & + MPI_COMM_WORLD, mpi_err) +#endif + end if #endif @@ -1013,18 +1044,16 @@ contains integer :: hdf5_err integer(HID_T) :: dset ! data set handle + integer(HID_T) :: dspace ! data space handle + integer(HID_T) :: memspace ! memory space handle + integer(HSIZE_T) :: dims(1) + integer(HSIZE_T) :: offset(1) ! offset of data type(c_ptr) :: f_ptr #ifdef PHDF5 integer :: data_xfer_mode integer(HID_T) :: plist ! property list - integer(HID_T) :: dspace ! data space handle - integer(HID_T) :: memspace ! memory space handle - integer(HSIZE_T) :: offset(1) ! offset of data - integer(HSIZE_T) :: dims(1) #endif -#ifdef PHDF5 - ! Open the dataset call h5dopen_f(group_id, "source_bank", dset, hdf5_err) @@ -1032,46 +1061,31 @@ contains dims(1) = work call h5screate_simple_f(1, dims, memspace, hdf5_err) - ! Get the individual local proc dataspace + ! Select hyperslab for each process call h5dget_space_f(dset, dspace, hdf5_err) - - ! Select hyperslab for this dataspace offset(1) = work_index(rank) 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) - ! Read data from file in parallel +#ifdef PHDF5 + ! Read data in parallel + call h5pcreate_f(H5P_DATASET_XFER_F, plist, hdf5_err) + call h5pset_dxpl_mpio_f(plist, H5FD_MPIO_COLLECTIVE_F, hdf5_err) call h5dread_f(dset, hdf5_bank_t, f_ptr, hdf5_err, & file_space_id=dspace, mem_space_id=memspace, & xfer_prp=plist) + call h5pclose_f(plist, hdf5_err) +#else + call h5dread_f(dset, hdf5_bank_t, f_ptr, hdf5_err, & + file_space_id=dspace, mem_space_id=memspace) +#endif ! 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 - - ! Open dataset - call h5dopen_f(group_id, "source_bank", dset, hdf5_err) - - ! Set up pointer to data - f_ptr = c_loc(source_bank) - - ! 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 end subroutine read_source_bank From 13c4d3ccddce0c991d3c2f989554022e45e62701 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 4 Sep 2015 12:32:26 +0700 Subject: [PATCH 13/32] Write number of particles/batches in summary file for fixed source --- src/hdf5_summary.F90 | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/src/hdf5_summary.F90 b/src/hdf5_summary.F90 index e8f566c43..3b28e885d 100644 --- a/src/hdf5_summary.F90 +++ b/src/hdf5_summary.F90 @@ -33,23 +33,22 @@ contains ! Write header information call hdf5_write_header(file_id) - ! Write eigenvalue information + ! Write number of particles + call write_dataset(file_id, "n_particles", n_particles) + call write_dataset(file_id, "n_batches", n_batches) + call write_attribute_string(file_id, "n_particles", & + "description", "Number of particles per generation") + call write_attribute_string(file_id, "n_batches", & + "description", "Total number of batches") + + ! Write eigenvalue information if (run_mode == MODE_EIGENVALUE) then - - ! Write number of particles - call write_dataset(file_id, "n_particles", n_particles) - - ! Use H5LT interface to write n_batches, n_inactive, and n_active - call write_dataset(file_id, "n_batches", n_batches) + ! write number of inactive/active batches and generations/batch call write_dataset(file_id, "n_inactive", n_inactive) call write_dataset(file_id, "n_active", n_active) call write_dataset(file_id, "gen_per_batch", gen_per_batch) ! Add description of each variable - call write_attribute_string(file_id, "n_particles", & - "description", "Number of particles per generation") - call write_attribute_string(file_id, "n_batches", & - "description", "Total number of batches") call write_attribute_string(file_id, "n_inactive", & "description", "Number of inactive batches") call write_attribute_string(file_id, "n_active", & From 6d3199b7ab37ad5664ca3b810f1031d381e41f1f Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 4 Sep 2015 12:34:03 +0700 Subject: [PATCH 14/32] Get rid of unused read_source routine in state_point module --- src/state_point.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/state_point.F90 b/src/state_point.F90 index aca6fafb7..0267ed4ec 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -1089,8 +1089,4 @@ contains end subroutine read_source_bank - 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 04aecbcb948acbaeaca6cfc3c68a292db74fdcda Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 4 Sep 2015 12:50:19 +0700 Subject: [PATCH 15/32] Remove remnants of binary files --- tests/cleanup | 4 ++-- .../test_filter_distribcell/test_filter_distribcell.py | 5 ++--- tests/test_output/test_output.py | 4 ++-- tests/test_source_file/test_source_file.py | 10 ++++------ tests/test_sourcepoint_batch/test_sourcepoint_batch.py | 7 +++---- .../test_sourcepoint_interval.py | 7 +++---- .../test_sourcepoint_latest/test_sourcepoint_latest.py | 5 ++--- .../test_statepoint_sourcesep.py | 5 ++--- tests/test_track_output/test_track_output.py | 4 ++-- 9 files changed, 22 insertions(+), 29 deletions(-) diff --git a/tests/cleanup b/tests/cleanup index 7b81d2d9d..3369c797e 100755 --- a/tests/cleanup +++ b/tests/cleanup @@ -5,6 +5,6 @@ # folders. This can occur if a previous error # occurred and the test suite was rerun without # deleting left over binary files. This will -# cause an assertion error in some of the +# cause an assertion error in some of the # tests. -find . \( -name "*.binary" -o -name "*.h5" -o -name "*.ppm" \) -exec rm -f {} \; +find . \( -name "*.h5" -o -name "*.ppm" \) -exec rm -f {} \; diff --git a/tests/test_filter_distribcell/test_filter_distribcell.py b/tests/test_filter_distribcell/test_filter_distribcell.py index 492f03dae..8370e40e7 100644 --- a/tests/test_filter_distribcell/test_filter_distribcell.py +++ b/tests/test_filter_distribcell/test_filter_distribcell.py @@ -67,9 +67,8 @@ class DistribcellTestHarness(TestHarness): statepoint = glob.glob(os.path.join(os.getcwd(), self._sp_name)) assert len(statepoint) == 1, 'Either multiple or no statepoint files ' \ 'exist.' - assert statepoint[0].endswith('binary') \ - or statepoint[0].endswith('h5'), \ - 'Statepoint file is not a binary or hdf5 file.' + assert statepoint[0].endswith('h5'), \ + 'Statepoint file is not a HDF5 file.' if tallies_out_present: assert os.path.exists(os.path.join(os.getcwd(), 'tallies.out')), \ 'Tally output file does not exist.' diff --git a/tests/test_output/test_output.py b/tests/test_output/test_output.py index 1f51742ba..0225d9fed 100644 --- a/tests/test_output/test_output.py +++ b/tests/test_output/test_output.py @@ -14,8 +14,8 @@ class OutputTestHarness(TestHarness): # Check for the summary. summary = glob.glob(os.path.join(os.getcwd(), 'summary.*')) assert len(summary) == 1, 'Either multiple or no summary file exists.' - assert summary[0].endswith('out') or summary[0].endswith('h5'),\ - 'Summary file is not a binary or hdf5 file.' + assert summary[0].endswith('h5'),\ + 'Summary file is not a HDF5 file.' # Check for the cross sections. assert os.path.exists(os.path.join(os.getcwd(), 'cross_sections.out')),\ diff --git a/tests/test_source_file/test_source_file.py b/tests/test_source_file/test_source_file.py index d9aaa9a0f..d7ed8b80a 100644 --- a/tests/test_source_file/test_source_file.py +++ b/tests/test_source_file/test_source_file.py @@ -66,15 +66,13 @@ class SourceFileTestHarness(TestHarness): statepoint = glob.glob(os.path.join(os.getcwd(), self._sp_name)) assert len(statepoint) == 1, 'Either multiple or no statepoint files ' \ 'exist.' - assert statepoint[0].endswith('binary') \ - or statepoint[0].endswith('h5'), \ - 'Statepoint file is not a binary or hdf5 file.' + assert statepoint[0].endswith('h5'), \ + 'Statepoint file is not a HDF5 file.' source = glob.glob(os.path.join(os.getcwd(), 'source.10.*')) assert len(source) == 1, 'Either multiple or no source files exist.' - assert source[0].endswith('binary') \ - or source[0].endswith('h5'), \ - 'Source file is not a binary or hdf5 file.' + assert source[0].endswith('h5'), \ + 'Source file is not a HDF5 file.' def _run_openmc_restart(self): # Get the name of the source file. diff --git a/tests/test_sourcepoint_batch/test_sourcepoint_batch.py b/tests/test_sourcepoint_batch/test_sourcepoint_batch.py index 8cafb4108..a90223659 100644 --- a/tests/test_sourcepoint_batch/test_sourcepoint_batch.py +++ b/tests/test_sourcepoint_batch/test_sourcepoint_batch.py @@ -9,10 +9,9 @@ class SourcepointTestHarness(TestHarness): def _test_output_created(self): """Make sure statepoint.* files have been created.""" statepoint = glob.glob(os.path.join(os.getcwd(), 'statepoint.*')) - assert len(statepoint) == 5, '5 statepoint files must exist.' - assert statepoint[0].endswith('binary') \ - or statepoint[0].endswith('h5'), \ - 'Statepoint file is not a binary or hdf5 file.' + assert len(statepoint) == 5, '5 statepoint files must exist.' + assert statepoint[0].endswith('h5'), \ + 'Statepoint file is not a HDF5 file.' def _get_results(self): """Digest info in the statepoint and return as a string.""" diff --git a/tests/test_sourcepoint_interval/test_sourcepoint_interval.py b/tests/test_sourcepoint_interval/test_sourcepoint_interval.py index 8cafb4108..a90223659 100644 --- a/tests/test_sourcepoint_interval/test_sourcepoint_interval.py +++ b/tests/test_sourcepoint_interval/test_sourcepoint_interval.py @@ -9,10 +9,9 @@ class SourcepointTestHarness(TestHarness): def _test_output_created(self): """Make sure statepoint.* files have been created.""" statepoint = glob.glob(os.path.join(os.getcwd(), 'statepoint.*')) - assert len(statepoint) == 5, '5 statepoint files must exist.' - assert statepoint[0].endswith('binary') \ - or statepoint[0].endswith('h5'), \ - 'Statepoint file is not a binary or hdf5 file.' + assert len(statepoint) == 5, '5 statepoint files must exist.' + assert statepoint[0].endswith('h5'), \ + 'Statepoint file is not a HDF5 file.' def _get_results(self): """Digest info in the statepoint and return as a string.""" diff --git a/tests/test_sourcepoint_latest/test_sourcepoint_latest.py b/tests/test_sourcepoint_latest/test_sourcepoint_latest.py index 5ae398462..8c04641b7 100644 --- a/tests/test_sourcepoint_latest/test_sourcepoint_latest.py +++ b/tests/test_sourcepoint_latest/test_sourcepoint_latest.py @@ -12,9 +12,8 @@ class SourcepointTestHarness(TestHarness): source = glob.glob(os.path.join(os.getcwd(), 'source.*')) assert len(source) == 1, 'Either multiple or no source files ' \ 'exist.' - assert source[0].endswith('binary') \ - or source[0].endswith('h5'), \ - 'Source file is not a binary or hdf5 file.' + assert source[0].endswith('h5'), \ + 'Source file is not a HDF5 file.' if __name__ == '__main__': diff --git a/tests/test_statepoint_sourcesep/test_statepoint_sourcesep.py b/tests/test_statepoint_sourcesep/test_statepoint_sourcesep.py index 861a04f18..acbb0180b 100644 --- a/tests/test_statepoint_sourcesep/test_statepoint_sourcesep.py +++ b/tests/test_statepoint_sourcesep/test_statepoint_sourcesep.py @@ -12,9 +12,8 @@ class SourcepointTestHarness(TestHarness): source = glob.glob(os.path.join(os.getcwd(), 'source.*')) assert len(source) == 1, 'Either multiple or no source files ' \ 'exist.' - assert source[0].endswith('binary') \ - or source[0].endswith('h5'), \ - 'Source file is not a binary or hdf5 file.' + assert source[0].endswith('h5'), \ + 'Source file is not a HDF5 file.' if __name__ == '__main__': diff --git a/tests/test_track_output/test_track_output.py b/tests/test_track_output/test_track_output.py index 31d29b742..1192d1b3a 100644 --- a/tests/test_track_output/test_track_output.py +++ b/tests/test_track_output/test_track_output.py @@ -16,8 +16,8 @@ class TrackTestHarness(TestHarness): outputs.append(glob.glob(''.join((os.getcwd(), '/track_1_1_2.*')))) for files in outputs: assert len(files) == 1, 'Multiple or no track files detected.' - assert files[0].endswith('binary') or files[0].endswith('h5'),\ - 'Track files are not binary or hdf5 files' + assert files[0].endswith('h5'),\ + 'Track files are not HDF5 files' def _get_results(self): """Digest info in the statepoint and return as a string.""" From 415f4684bc0c90875e5885c1c8ec3ef00f51ce5e Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 4 Sep 2015 15:29:05 +0700 Subject: [PATCH 16/32] Add two missing use ISO_C_BINDING statements --- src/initialize.F90 | 2 ++ src/state_point.F90 | 2 ++ 2 files changed, 4 insertions(+) diff --git a/src/initialize.F90 b/src/initialize.F90 index 29e5f8921..68fccf417 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -36,6 +36,8 @@ module initialize use hdf5 + use, intrinsic :: ISO_C_BINDING, only: c_loc + implicit none contains diff --git a/src/state_point.F90 b/src/state_point.F90 index 0267ed4ec..7688d5d33 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -28,6 +28,8 @@ module state_point use hdf5 + use, intrinsic :: ISO_C_BINDING, only: c_loc, c_ptr + implicit none contains From 40d99bac13b10069fe884848b3d266d9c0342f06 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 4 Sep 2015 15:34:29 +0700 Subject: [PATCH 17/32] Dont use -Wall with gfortran 4.6 (causes lots of unused variable warnings on Travis from HDF5 common blocks) --- CMakeLists.txt | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 623eb0dcb..76c099d52 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -110,7 +110,10 @@ if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) # GNU Fortran compiler options list(APPEND f90flags -cpp -std=f2008 -fbacktrace) if(debug) - list(APPEND f90flags -g -Wall -pedantic -fbounds-check + if(NOT (GCC_VERSION VERSION_LESS 4.7)) + list(APPEND f90flags -Wall) + endif() + list(APPEND f90flags -g -pedantic -fbounds-check -ffpe-trap=invalid,overflow,underflow) list(APPEND ldflags -g) endif() From e57d87ab8fe5c9ab9a13ad9ae70c612450f78b53 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 5 Sep 2015 16:22:22 +0800 Subject: [PATCH 18/32] Respond to @wbinventor comments on pull request #447 --- openmc/statepoint.py | 9 ++-- scripts/openmc-track-to-vtk | 5 --- src/initialize.F90 | 4 +- src/{hdf5_summary.F90 => summary.F90} | 59 ++++++++++++++------------- 4 files changed, 38 insertions(+), 39 deletions(-) rename src/{hdf5_summary.F90 => summary.F90} (96%) diff --git a/openmc/statepoint.py b/openmc/statepoint.py index af423b027..06ed51c18 100644 --- a/openmc/statepoint.py +++ b/openmc/statepoint.py @@ -199,7 +199,7 @@ class StatePoint(object): self._n_inactive = self._f['n_inactive'].value self._gen_per_batch = self._f['gen_per_batch'].value - self._k_batch = self._f['k_generation'].value + self._k_generation = self._f['k_generation'].value self._entropy = self._f['entropy'].value self._k_col_abs = self._f['k_col_abs'].value @@ -358,7 +358,7 @@ class StatePoint(object): filter.num_bins = n_bins if FILTER_TYPES[filter_type] == 'mesh': - key = self._mesh_keys[list(self._mesh_ids).index(bins)] + key = self._mesh_keys[self._mesh_ids == bins][0] filter.mesh = self._meshes[key] # Add Filter to the Tally @@ -378,8 +378,9 @@ class StatePoint(object): tally.num_score_bins = n_score_bins - scores = [SCORE_TYPES[j] for j in self._f[ - '{0}{1}/score_bins'.format(base, tally_key)].value] + score_bins = self._f['{0}{1}/score_bins'.format( + base, tally_key)].value + scores = [SCORE_TYPES[score] for score in score_bins] n_user_scores = self._f['{0}{1}/n_user_score_bins' .format(base, tally_key)].value diff --git a/scripts/openmc-track-to-vtk b/scripts/openmc-track-to-vtk index c900c4aa5..e22a22dea 100755 --- a/scripts/openmc-track-to-vtk +++ b/scripts/openmc-track-to-vtk @@ -40,11 +40,6 @@ def main(): # Parse commandline arguments. args = _parse_args() - # Check input file extensions. - for fname in args.input: - if not fname.endswith('.h5'): - raise ValueError("Input file names must an HDF5 file.") - # Make sure that the output filename ends with '.pvtp'. if not args.out: args.out = 'tracks.pvtp' diff --git a/src/initialize.F90 b/src/initialize.F90 index 68fccf417..bd479032f 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -14,7 +14,6 @@ module initialize use global use hdf5_interface, only: file_open, read_dataset, file_close, hdf5_bank_t,& hdf5_tallyresult_t, hdf5_integer8_t - use hdf5_summary, only: hdf5_write_summary use input_xml, only: read_input_xml, read_cross_sections_xml, & cells_in_univ_dict, read_plots_xml use material_header, only: Material @@ -23,6 +22,7 @@ module initialize use random_lcg, only: initialize_prng use state_point, only: load_state_point use string, only: to_str, str_to_int, starts_with, ends_with + use summary, only: write_summary use tally_header, only: TallyObject, TallyResult, TallyFilter use tally_initialize, only: configure_tallies @@ -153,7 +153,7 @@ contains call print_plot() else ! Write summary information - if (output_summary) call hdf5_write_summary() + if (output_summary) call write_summary() ! Write cross section information if (output_xs) call write_xs_summary() diff --git a/src/hdf5_summary.F90 b/src/summary.F90 similarity index 96% rename from src/hdf5_summary.F90 rename to src/summary.F90 index 3b28e885d..cc9a909c8 100644 --- a/src/hdf5_summary.F90 +++ b/src/summary.F90 @@ -1,4 +1,4 @@ -module hdf5_summary +module summary use ace_header, only: Reaction, UrrData, Nuclide use constants @@ -16,14 +16,17 @@ module hdf5_summary use hdf5 implicit none + private + + public :: write_summary contains !=============================================================================== -! HDF5_WRITE_SUMMARY +! WRITE_SUMMARY !=============================================================================== - subroutine hdf5_write_summary() + subroutine write_summary() integer(HID_T) :: file_id @@ -31,7 +34,7 @@ contains file_id = file_create("summary.h5") ! Write header information - call hdf5_write_header(file_id) + call write_header(file_id) ! Write number of particles call write_dataset(file_id, "n_particles", n_particles) @@ -57,23 +60,23 @@ contains "description", "Number of generations per batch") end if - call hdf5_write_geometry(file_id) - call hdf5_write_materials(file_id) - call hdf5_write_nuclides(file_id) + call write_geometry(file_id) + call write_materials(file_id) + call write_nuclides(file_id) if (n_tallies > 0) then - call hdf5_write_tallies(file_id) + call write_tallies(file_id) end if ! Terminate access to the file. call file_close(file_id) - end subroutine hdf5_write_summary + end subroutine write_summary !=============================================================================== -! HDF5_WRITE_HEADER +! WRITE_HEADER !=============================================================================== - subroutine hdf5_write_header(file_id) + subroutine write_header(file_id) integer(HID_T), intent(in) :: file_id ! Write version information @@ -89,13 +92,13 @@ contains call write_attribute_string(file_id, "n_procs", "description", & "Number of MPI processes") - end subroutine hdf5_write_header + end subroutine write_header !=============================================================================== -! HDF5_WRITE_GEOMETRY +! WRITE_GEOMETRY !=============================================================================== - subroutine hdf5_write_geometry(file_id) + subroutine write_geometry(file_id) integer(HID_T), intent(in) :: file_id integer :: i, j, k, m @@ -379,13 +382,13 @@ contains call close_group(lattices_group) call close_group(geom_group) - end subroutine hdf5_write_geometry + end subroutine write_geometry !=============================================================================== -! HDF5_WRITE_MATERIALS +! WRITE_MATERIALS !=============================================================================== - subroutine hdf5_write_materials(file_id) + subroutine write_materials(file_id) integer(HID_T), intent(in) :: file_id integer :: i @@ -452,13 +455,13 @@ contains call close_group(materials_group) - end subroutine hdf5_write_materials + end subroutine write_materials !=============================================================================== -! HDF5_WRITE_TALLIES +! WRITE_TALLIES !=============================================================================== - subroutine hdf5_write_tallies(file_id) + subroutine write_tallies(file_id) integer(HID_T), intent(in) :: file_id integer :: i, j @@ -580,13 +583,13 @@ contains call close_group(tallies_group) - end subroutine hdf5_write_tallies + end subroutine write_tallies !=============================================================================== -! HDF5_WRITE_NUCLIDES +! WRITE_NUCLIDES !=============================================================================== - subroutine hdf5_write_nuclides(file_id) + subroutine write_nuclides(file_id) integer(HID_T), intent(in) :: file_id integer :: i, j @@ -689,13 +692,13 @@ contains call close_group(nuclides_group) - end subroutine hdf5_write_nuclides + end subroutine write_nuclides !=============================================================================== -! HDF5_WRITE_TIMING +! WRITE_TIMING !=============================================================================== - subroutine hdf5_write_timing(file_id) + subroutine write_timing(file_id) integer(HID_T), intent(in) :: file_id integer(8) :: total_particles @@ -748,6 +751,6 @@ contains call write_dataset(time_group, "neutrons_per_second", speed) call close_group(time_group) - end subroutine hdf5_write_timing + end subroutine write_timing -end module hdf5_summary +end module summary From 517628daf1a17ccb83fe76b0c0b9d1d05c21ea86 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 11 Sep 2015 10:10:56 +0400 Subject: [PATCH 19/32] Respond to @smharper comments on pull request #447 --- src/hdf5_interface.F90 | 34 ++++++++++++++++++++++------------ 1 file changed, 22 insertions(+), 12 deletions(-) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index 491337e00..f4771d848 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -1,13 +1,16 @@ module hdf5_interface - ! This module provides the high-level procedures which greatly simplify - ! writing/reading different types of data to HDF5 files. In order to get it to - ! work with gfotran 4.6, all the write__ND subroutines had to be split - ! into two procedures, one accepting an assumed-shape array and another one - ! with an explicit-shape array since in gfortran 4.6 C_LOC does not work with - ! an assumed-shape array. When we move to gfortran 4.9+, these procedures can - ! be combined into one simply accepting an assumed-shape array. +!============================================================================== +! HDF5_INTERFACE -- This module provides the high-level procedures which greatly +! simplify writing/reading different types of data to HDF5 files. In order to +! get it to work with gfotran 4.6, all the write__ND subroutines had to be +! split into two procedures, one accepting an assumed-shape array and another +! one with an explicit-shape array since in gfortran 4.6 C_LOC does not work +! with an assumed-shape array. When we move to gfortran 4.9+, these procedures +! can be combined into one simply accepting an assumed-shape array. +!============================================================================== + use error, only: fatal_error use tally_header, only: TallyResult use hdf5 @@ -138,7 +141,7 @@ contains ! Determine access type open_mode = H5F_ACC_RDONLY_F - if (trim(mode) == 'w') open_mode = H5F_ACC_RDWR_F + if (mode == 'w') open_mode = H5F_ACC_RDWR_F if (parallel_) then ! Setup file access property list with parallel I/O access @@ -192,8 +195,12 @@ contains ! Check if group exists call h5ltpath_valid_f(group_id, trim(name), .true., exists, hdf5_err) - ! Either create or open group - if (exists) call h5gopen_f(group_id, trim(name), newgroup_id, hdf5_err) + ! open group if it exists + if (exists) then + call h5gopen_f(group_id, trim(name), newgroup_id, hdf5_err) + else + call fatal_error("The group '" // trim(name) // "' does not exist.") + end if end function open_group !=============================================================================== @@ -212,8 +219,11 @@ contains call h5ltpath_valid_f(group_id, trim(name), .true., exists, hdf5_err) ! create group - if (.not. exists) & - call h5gcreate_f(group_id, trim(name), newgroup_id, hdf5_err) + if (exists) then + call fatal_error("The group '" // trim(name) // "' already exists.") + else + call h5gcreate_f(group_id, trim(name), newgroup_id, hdf5_err) + end if end function create_group !=============================================================================== From a978225ba9fb6847f5f242153027f13a89dc8f00 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Fri, 11 Sep 2015 10:11:45 +0400 Subject: [PATCH 20/32] Remove openmc-tally-convergence script --- scripts/openmc-tally-convergence | 375 ------------------------------- 1 file changed, 375 deletions(-) delete mode 100755 scripts/openmc-tally-convergence diff --git a/scripts/openmc-tally-convergence b/scripts/openmc-tally-convergence deleted file mode 100755 index 81f45fd71..000000000 --- a/scripts/openmc-tally-convergence +++ /dev/null @@ -1,375 +0,0 @@ -#!/usr/bin/env python - -# This program takes OpenMC statepoint binary files and creates a variety of -# outputs from them which should provide the user with an idea of the -# convergence behavior of all the tallies and filters defined by the user in -# tallies.xml. The program can directly plot the value and errors of each -# tally, filter, score combination; it can save these plots to a file; and -# it can also save the data used in these plots to a CSV file for importing in -# to other plotting packages such as Excel, gnuplot, MathGL, or Veusz. - -# To use the program, run this program from the working directory of the openMC -# problem to analyze. - -# The USER OPTIONS block below provides four options for the user to set: -# fileType, printxs, showImg, and savetoCSV. See the options block for more -# information. - -from __future__ import print_function -from math import sqrt, pow -from glob import glob - -import numpy as np -import scipy.stats -import matplotlib.pyplot as plt - -from openmc.statepoint import StatePoint - -##################################### USER OPTIONS - -# Set filetype (the file extension desired, without the period.) -# Options are backend dependent, but most backends support png, pdf, ps, eps -# and svg. Write "none" if no saved files are desired. -fileType = "none" - -# Set if cross-sections or reaction rates are desired printxs = True means X/S -printxs = False - -# Set if the figures should be displayed to screen or not (True means show) -showImg = False - -# Save to CSV for use in more advanced plotting programs like GNUPlot, MathGL -savetoCSV = True - -##################################### END USER OPTIONS - -## Find if tallies.xml exists. -#if glob('./tallies.xml') != None: -# # It exists -# tallyData = talliesXML('tallies.xml') -#else: -# # It does not exist. -# tallyData = None - -# Find all statepoints in this directory. -files = glob('./statepoint.*.binary') -fileNums = [] -begin = 13 -# Arrange the file list in increasing batch order -for i in range(len(files)): - end = files[i].find(".binary") - fileNums.append(int(files[i][begin:end])) -fileNums.sort() -# Re-make filenames -files = [] -for i in range(len(fileNums)): - files.append("./statepoint." + str(fileNums[i]) + ".binary") - -# Initialize arrays as needed -mean = [None for x in range(len(files))] -uncert = [None for x in range(len(files))] -scoreType = [None for x in range(len(files))] -active_batches = [None for x in range(len(files))] - -for i_batch in range(len(files)): - - # Get filename - batch_filename = files[i_batch] - - # Create StatePoint object - sp = StatePoint(batch_filename) - - # Read number of realizations for global tallies - sp.n_realizations = sp._get_int()[0] - - # Read global tallies - n_global_tallies = sp._get_int()[0] - sp.global_tallies = np.array(sp._get_double(2*n_global_tallies)) - sp.global_tallies.shape = (n_global_tallies, 2) - - # Flag indicating if tallies are present - tallies_present = sp._get_int()[0] - - # Check if tallies are present - if not tallies_present: - raise Exception("No tally data in state point!") - - # Increase the dimensionality of our main variables - mean[i_batch] = [None for x in range(len(sp.tallies))] - uncert[i_batch] = [None for x in range(len(sp.tallies))] - scoreType[i_batch] = [None for x in range(len(sp.tallies))] - - # Loop over all tallies - for i_tally, t in enumerate(sp.tallies): - # Calculate t-value for 95% two-sided CI - n = t.n_realizations - t_value = scipy.stats.t.ppf(0.975, n - 1) - - # Store the batch count - active_batches[i_batch] = n - - # Resize the 2nd dimension - mean[i_batch][i_tally] = [None for x in range(t.total_filter_bins)] - uncert[i_batch][i_tally] = [None for x in range(t.total_filter_bins)] - scoreType[i_batch][i_tally] = [None for x in range(t.total_filter_bins)] - - for i_filter in range(t.total_filter_bins): - # Resize the 3rd dimension - mean[i_batch][i_tally][i_filter] = [None for x in range(t.n_nuclides)] - uncert[i_batch][i_tally][i_filter] = [None for x in range(t.n_nuclides)] - scoreType[i_batch][i_tally][i_filter] = [None for x in range(t.n_nuclides)] - print(t.total_filter_bins,t.n_nuclides) - for i_nuclide in range(t.n_nuclides): - mean[i_batch][i_tally][i_filter][i_nuclide] = \ - [None for x in range(t.n_scores)] - uncert[i_batch][i_tally][i_filter][i_nuclide] = \ - [None for x in range(t.n_scores)] - scoreType[i_batch][i_tally][i_filter][i_nuclide] = \ - [None for x in range(t.n_scores)] - for i_score in range(t.n_scores): - scoreType[i_batch][i_tally][i_filter][i_nuclide][i_score] = \ - t.scores[i_score] - s, s2 = sp._get_double(2) - s /= n - mean[i_batch][i_tally][i_filter][i_nuclide][i_score] = s - if s != 0.0: - relative_error = t_value*sqrt((s2/n - s*s)/(n-1))/s - else: - relative_error = 0.0 - uncert[i_batch][i_tally][i_filter][i_nuclide][i_score] = relative_error - -# Reorder the data lists in to a list order more conducive for plotting: -# The indexing should be: [tally][filter][score][batch] -meanPlot = [None for x in range(len(mean[0]))] # Set to the number of tallies -uncertPlot = [None for x in range(len(mean[0]))] # Set to the number of tallies -absUncertPlot = [None for x in range(len(mean[0]))] # Set to number of tallies -filterLabel = [None for x in range(len(mean[0]))] #Set to the number of tallies -fluxLoc = [None for x in range(len(mean[0]))] # Set to the number of tallies -printxs = [False for x in range(len(mean[0]))] # Set to the number of tallies - -# Get and set the correct sizes for the rest of the dimensions -for i_tally in range(len(meanPlot)): - # Set 2nd (score) dimension - meanPlot[i_tally] = [None for x in range(len(mean[0][i_tally]))] - uncertPlot[i_tally] = [None for x in range(len(mean[0][i_tally]))] - absUncertPlot[i_tally] = [None for x in range(len(mean[0][i_tally]))] - filterLabel[i_tally] = [None for x in range(len(mean[0][i_tally]))] - - # Initialize flux location so it will be -1 if not found - fluxLoc[i_tally] = -1 - - for i_filter in range(len(meanPlot[i_tally])): - # Set 3rd (filter) dimension - meanPlot[i_tally][i_filter] = \ - [None for x in range(len(mean[0][i_tally][i_filter]))] - uncertPlot[i_tally][i_filter] = \ - [None for x in range(len(mean[0][i_tally][i_filter]))] - absUncertPlot[i_tally][i_filter] = \ - [None for x in range(len(mean[0][i_tally][i_filter]))] - filterLabel[i_tally][i_filter] = \ - [None for x in range(len(mean[0][i_tally][i_filter]))] - - for i_nuclide in range(len(meanPlot[i_tally][i_filter])): - # Set 4th (nuclide)) dimension - meanPlot[i_tally][i_filter][i_nuclide] = \ - [None for x in range(len(mean[0][i_tally][i_filter][i_nuclide]))] - uncertPlot[i_tally][i_filter][i_nuclide] = \ - [None for x in range(len(mean[0][i_tally][i_filter][i_nuclide]))] - absUncertPlot[i_tally][i_filter][i_nuclide] = \ - [None for x in range(len(mean[0][i_tally][i_filter][i_nuclide]))] - - for i_score in range(len(meanPlot[i_tally][i_filter][i_nuclide])): - # Set 5th (batch) dimension - meanPlot[i_tally][i_filter][i_nuclide][i_score] = \ - [None for x in range(len(mean))] - uncertPlot[i_tally][i_filter][i_nuclide][i_score] = \ - [None for x in range(len(mean))] - absUncertPlot[i_tally][i_filter][i_nuclide][i_score] = \ - [None for x in range(len(mean))] - - # Get filterLabel (this should be moved to its own function) - #??? How to do? - - # Set flux location if found - # all batches and all tallies will have the same score ordering, hence - # the 0's in the 1st, 3rd, and 4th dimensions. - if scoreType[0][i_tally][0][0][i_score] == 'flux': - fluxLoc[i_tally] = i_score - -# Set printxs array according to the printxs input -if printxs: - for i_tally in range(len(fluxLoc)): - if fluxLoc[i_tally] != -1: - printxs[i_tally] = True - -# Now rearrange the data as suitable, and perform xs conversion if necessary -for i_batch in range(len(mean)): - for i_tally in range(len(mean[i_batch])): - for i_filter in range(len(mean[i_batch][i_tally])): - for i_nuclide in range(len(mean[i_batch][i_tally][i_filter])): - for i_score in range(len(mean[i_batch][i_tally][i_filter][i_nuclide])): - if (printxs[i_tally] and \ - ((scoreType[0][i_tally][i_filter][i_nuclide][i_score] != 'flux') and \ - (scoreType[0][i_tally][i_filter][i_nuclide][i_score] != 'current'))): - - # Perform rate to xs conversion - # mean is mean/fluxmean - meanPlot[i_tally][i_filter][i_nuclide][i_score][i_batch] = \ - mean[i_batch][i_tally][i_filter][i_nuclide][i_score] / \ - mean[i_batch][i_tally][i_filter][i_nuclide][fluxLoc[i_tally]] - - # Update the relative uncertainty via error propagation - uncertPlot[i_tally][i_filter][i_nuclide][i_score][i_batch] = \ - sqrt(pow(uncert[i_batch][i_tally][i_filter][i_nuclide][i_score],2) \ - + pow(uncert[i_batch][i_tally][i_filter][i_nuclide][fluxLoc[i_tally]],2)) - else: - - # Do not perform rate to xs conversion - meanPlot[i_tally][i_filter][i_nuclide][i_score][i_batch] = \ - mean[i_batch][i_tally][i_filter][i_nuclide][i_score] - uncertPlot[i_tally][i_filter][i_nuclide][i_score][i_batch] = \ - uncert[i_batch][i_tally][i_filter][i_nuclide][i_score] - - # Both have the same absolute uncertainty calculation - absUncertPlot[i_tally][i_filter][i_nuclide][i_score][i_batch] = \ - uncert[i_batch][i_tally][i_filter][i_nuclide][i_score] * \ - mean[i_batch][i_tally][i_filter][i_nuclide][i_score] - -# Set plotting constants -xLabel = "Batches" -xLabel = xLabel.title() # not necessary for now, but is left in to handle if -# the previous line changes - -# Begin plotting -for i_tally in range(len(meanPlot)): - # Set tally string (placeholder until I put tally labels in statePoint) - tallyStr = "Tally " + str(i_tally + 1) - - for i_filter in range(len(meanPlot[i_tally])): - - # Set filter string - filterStr = "Filter " + str(i_filter + 1) - - for i_nuclide in range(len(meanPlot[i_tally][i_filter])): - - nuclideStr = "Nuclide " + str(i_nuclide + 1) - - for i_score in range(len(meanPlot[i_tally][i_filter][i_nuclide])): - - # Set score string - scoreStr = scoreType[i_batch][i_tally][i_filter][i_nuclide][i_score] - scoreStr = scoreStr.title() - if (printxs[i_tally] and ((scoreStr != 'Flux') and \ - (scoreStr != 'Current'))): - scoreStr = scoreStr + "-XS" - - # set Title - title = "Convergence of " + scoreStr + " in " + tallyStr + " for "\ - + filterStr + " and " + nuclideStr - - # set yLabel - yLabel = scoreStr - yLabel = yLabel.title() - - # Set saving filename - fileName = "tally_" + str(i_tally + 1) + "_" + scoreStr + \ - "_filter_" + str(i_filter+1) + "_nuclide_" + str(i_nuclide+1) \ - + "." + fileType - REfileName = "tally_" + str(i_tally + 1) + "_" + scoreStr + \ - "RE_filter_" + str(i_filter+1) + "_nuclide_" + str(i_nuclide+1) \ - + "." + fileType - - # Plot mean with absolute error bars - plt.errorbar(active_batches, \ - meanPlot[i_tally][i_filter][i_nuclide][i_score][:], \ - absUncertPlot[i_tally][i_filter][i_nuclide][i_score][:],fmt='o-',aa=True) - plt.xlabel(xLabel) - plt.ylabel(yLabel) - plt.title(title) - if (fileType != 'none'): - plt.savefig(fileName) - if showImg: - plt.show() - plt.clf() - - # Plot relative uncertainty - plt.plot(active_batches, \ - uncertPlot[i_tally][i_filter][i_nuclide][i_score][:],'o-',aa=True) - plt.xlabel(xLabel) - plt.ylabel("Relative Error of " + yLabel) - plt.title("Relative Error of " + title) - if (fileType != 'none'): - plt.savefig(REfileName) - if showImg: - plt.show() - plt.clf() - -if savetoCSV: - # This block loops through each tally, and for each tally: - # Creates a new file - # Writes the scores and filters for that tally in csv format. - # The columns will be: batches,then for each filter: all the scores - # The rows, of course, are the data points per batch. - - for i_tally in range(len(meanPlot)): - # Set tally string (placeholder until I put tally labels in statePoint) - tallyStr = "Tally " + str(i_tally + 1) - CSV_filename = "./tally" + str(i_tally+1)+".csv" - # Open the file - f = open(CSV_filename, 'w') - - # Write the header line - - lineText = "Batches" - - for i_filter in range(len(meanPlot[i_tally])): - - # Set filter string - filterStr = "Filter " + str(i_filter + 1) - - for i_nuclide in range(len(meanPlot[i_tally][i_filter])): - - nuclideStr = "Nuclide " + str(i_nuclide + 1) - - for i_score in range(len(meanPlot[i_tally][i_filter][i_nuclide])): - - # Set the title - scoreStr = scoreType[i_batch][i_tally][i_filter][i_nuclide][i_score] - scoreStr = scoreStr.title() - if (printxs[i_tally] and ((scoreStr != 'Flux') and \ - (scoreStr != 'Current'))): - scoreStr = scoreStr + "-XS" - - # set header - headerText = scoreStr + " for " + filterStr + " for " + nuclideStr - - lineText = lineText + "," + headerText + \ - ",Abs Unc of " + headerText + \ - ",Rel Unc of " + headerText - - f.write(lineText + "\n") - - # Write the data lines, each row is a different batch - - for i_batch in range(len(meanPlot[i_tally][0][0][0])): - - lineText = repr(active_batches[i_batch]) - - for i_filter in range(len(meanPlot[i_tally])): - - for i_nuclide in range(len(meanPlot[i_tally][i_filter])): - - for i_score in range(len(meanPlot[i_tally][i_filter][i_nuclide])): - - fieldText = \ - repr(meanPlot[i_tally][i_filter][i_nuclide][i_score][i_batch]) + \ - "," + \ - repr(absUncertPlot[i_tally][i_filter][i_nuclide][i_score][i_batch]) +\ - "," + \ - repr(uncertPlot[i_tally][i_filter][i_nuclide][i_score][i_batch]) - - lineText = lineText + "," + fieldText - - f.write(lineText + "\n") - - From 4994493397e31ff59c4d1fee7d39778cee5569f9 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 12 Sep 2015 00:31:50 +0800 Subject: [PATCH 21/32] Add two test configurations to Travis pull request runs --- tests/travis.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/travis.sh b/tests/travis.sh index af54b4ff6..443e951cc 100755 --- a/tests/travis.sh +++ b/tests/travis.sh @@ -5,7 +5,7 @@ set -ev # Run all debug tests ./check_source.py if [ "$TRAVIS_PULL_REQUEST" != "false" ]; then - ./run_tests.py -C "^hdf5-debug$|^phdf5-debug$|^phdf5-omp-debug$" -j 2 -s + ./run_tests.py -C "^hdf5-debug$|^omp-hdf5-debug|^mpi-hdf5-debug|^phdf5-debug$|^phdf5-omp-debug$" -j 2 -s else ./run_tests.py -C "^hdf5-debug$" -j 2 fi From a569ce786b78d3c92a95129ac3fe5bf3c0f8e61a Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 12 Sep 2015 12:24:27 +0700 Subject: [PATCH 22/32] Revise documentation for statepoint format --- docs/source/devguide/statepoint.rst | 229 +++++++++++++--------------- docs/source/quickinstall.rst | 4 +- docs/source/usersguide/install.rst | 64 ++++---- 3 files changed, 146 insertions(+), 151 deletions(-) diff --git a/docs/source/devguide/statepoint.rst b/docs/source/devguide/statepoint.rst index 4a1db9478..7b0862056 100644 --- a/docs/source/devguide/statepoint.rst +++ b/docs/source/devguide/statepoint.rst @@ -6,286 +6,271 @@ State Point Binary File Specifications The current revision of the statepoint binary file is 13. -**integer(4) FILETYPE_STATEPOINT** +**/filetype** (*int*) - Flags whether this file is a statepoint file or a particle restart file. + Flags what type of file this is. A value of -1 indicates a statepoint file, + a value of -2 indicates a particle restart file, and a value of -3 indicates + a source file. -**integer(4) REVISION_STATEPOINT** +**/revision** (*int*) Revision of the binary state point file. Any time a change is made in the format of the state-point file, this integer is incremented. -**integer(4) VERSION_MAJOR** +**/version_major** (*int*) Major version number for OpenMC -**integer(4) VERSION_MINOR** +**/version_minor** (*int*) Minor version number for OpenMC -**integer(4) VERSION_RELEASE** +**/version_release** (*int*) Release version number for OpenMC -**character(19) time_stamp** +**/time_stamp** (*char[19]*) Date and time the state point was written. -**character(255) path** +**/path** (*char[255]*) Absolute path to directory containing input files. -**integer(8) seed** +**/seed** (*int8_t*) Pseudo-random number generator seed. -**integer(4) run_mode** +**/run_mode** (*int*) - run mode used. The modes are described in constants.F90. + Run mode used. A value of 1 indicates a fixed-source run and a value of 2 + indicates an eigenvalue run. -**integer(8) n_particles** +**/n_particles** (*int8_t*) Number of particles used per generation. -**integer(4) current_batch** +**/n_batches** (*int*) + + Number of batches to simulate. + +**/current_batch** (*int*) The number of batches already simulated. if (run_mode == MODE_EIGENVALUE) - **integer(4) n_inactive** + **/n_inactive** (*int*) - Number of inactive batches + Number of inactive batches. - **integer(4) gen_per_batch** + **gen_per_batch** (*int*) - Number of generations per batch for criticality calculations + Number of generations per batch. - *do i = 1, current_batch \* gen_per_batch* + **/k_generation** (*double[]*) - **real(8) k_generation(i)** + k-effective for each generation simulated. - k-effective for the i-th total generation + **/entropy** (*double[]*) - *do i = 1, current_batch \* gen_per_batch* + Shannon entropy for each generation simulated - **real(8) entropy(i)** - - Shannon entropy for the i-th total generation - - **real(8) k_col_abs** + **/k_col_abs** (*double*) Sum of product of collision/absorption estimates of k-effective - **real(8) k_col_tra** + **/k_col_tra** (*double*) Sum of product of collision/track-length estimates of k-effective - **real(8) k_abs_tra** + **/k_abs_tra** (*double*) Sum of product of absorption/track-length estimates of k-effective - **real(8) k_combined(2)** + **/k_combined** (*double[2]*) Mean and standard deviation of a combined estimate of k-effective - **integer(4) cmfd_on** + **/cmfd_on** (*int*) - Flag that cmfd is on + Flag indicating whether CMFD is on (1) or off (0). if (cmfd_on) - **integer(4) cmfd % indices** + **/cmfd/indices** (*int[4]*) Indices for cmfd mesh (i,j,k,g) - **real(8) cmfd % k_cmfd(1:current_batch)** + **/cmfd/k_cmfd** (*double[]*) CMFD eigenvalues - **real(8) cmfd % src(1:G,1:I,1:J,1:K)** + **/cmfd/cmfd_src** (*double[][][][]*) CMFD fission source - **real(8) cmfd % entropy(1:current_batch)** + **/cmfd/cmfd_entropy** (*double[]*) CMFD estimate of Shannon entropy - **real(8) cmfd % balance(1:current_batch)** + **/cmfd/cmfd_balance** (*double[]*) RMS of the residual neutron balance equation on CMFD mesh - **real(8) cmfd % dom(1:current_batch)** + **/cmfd/cmfd_dominance** (*double[]*) CMFD estimate of dominance ratio - **real(8) cmfd % scr_cmp(1:current_batch)** + **/cmfd/cmfd_srccmp** (*double[]*) RMS comparison of difference between OpenMC and CMFD fission source -**integer(4) n_meshes** +**/tallies/n_meshes** (*int*) Number of meshes in tallies.xml file +**/tally/meshes/ids** (*int[]*) + + Internal unique ID of each mesh. + +**/tally/meshes/keys** (*int[]*) + + User-identified unique ID of each mesh + *do i = 1, n_meshes* - **integer(4) meshes(i) % id** + **/tallies/meshes/mesh i/id** (*int*) - Unique ID of mesh. + Unique identifier of the mesh. - **integer(4) meshes(i) % type** + **/tallies/meshes/mesh i/type** (*int*) Type of mesh. - **integer(4) meshes(i) % n_dimension** + **/tallies/meshes/mesh i/n_dimension** (*int*) Number of dimensions for mesh (2 or 3). - **integer(4) meshes(i) % dimension(:)** + **/tallies/meshes/mesh i/dimension** (*int*) Number of mesh cells in each dimension. - **real(8) meshes(i) % lower_left(:)** + **/tallies/meshes/mesh i/lower_left** (*double[]*) Coordinates of lower-left corner of mesh. - **real(8) meshes(i) % upper_right(:)** + **/tallies/meshes/mesh i/upper_right** (*double[]*) Coordinates of upper-right corner of mesh. - **real(8) meshes(i) % width(:)** + **/tallies/meshes/mesh i/width** (*double[]*) Width of each mesh cell in each dimension. -**integer(4) n_tallies** +**/tallies/n_tallies** (*int*) + + Number of user-defined tallies. + +**/tallies/ids** (*int[]*) + + Internal unique ID of each tally. + +**/tallies/keys** (*int[]*) + + User-identified unique ID of each tally. *do i = 1, n_tallies* - **integer(4) tallies(i) % id** + **/tallies/tally i/estimator** (*int*) - Unique ID of tally. + Type of tally estimator: analog (1) or tracklength (2). - **integer(4) tallies(i) % n_realizations** + **/tallies/tally i/n_realizations** (*int*) - Number of realizations for the i-th tally. + Number of realizations. - **integer(4) size(tallies(i) % scores, 1)** + **/tallies/tally i/n_filters** (*int*) - Total number of score bins for the i-th tally - - **integer(4) size(tallies(i) % scores, 2)** - - Total number of filter bins for the i-th tally - - **integer(4) tallies(i) % n_filters** + Number of filters used. *do j = 1, tallies(i) % n_filters* - **integer(4) tallies(i) % filter(j) % type** + **/tallies/tally i/filter j/type** (*int*) Type of tally filter. - **integer(4) tallies(i) % filter(j) % n_bins** + **/tallies/tally i/filter j/offset** (*int*) + + Filter offset (used for distribcell). + + **/tallies/tally i/filter j/n_bins** (*int*) Number of bins for filter. - **integer(4)/real(8) tallies(i) % filter(j) % bins(:)** + **/tallies/tally i/filter j/bins** (*int[]* or *double[]*) Value for each filter bin of this type. - **integer(4) tallies(i) % n_nuclide_bins** + **/tallies/tally i/n_nuclides** (*int*) Number of nuclide bins. If none are specified, this is just one. - *do j = 1, tallies(i) % n_nuclide_bins* + **/tallies/tally i/nuclides** (*int[]*) - **integer(4) tallies(i) % nuclide_bins(j)** + Values of specified nuclide bins (ZAID identifiers) - Values of specified nuclide bins - - **integer(4) tallies(i) % n_score_bins** + **/tallies/tally i/n_score_bins** (*int*) Number of scoring bins. - *do j = 1, tallies(i) % n_score_bins* + **/tallies/tally i/score_bins** (*int*) - **integer(4) tallies(i) % score_bins(j)** + Values of specified scoring bins (e.g. SCORE_FLUX). - Values of specified scoring bins (e.g. SCORE_FLUX). - - **integer(4) tallies(i) % n_score_bins** + **/tallies/tally i/n_user_score_bins** Number of scoring bins without accounting for those added by - the scatter-pn command. + expansions, e.g. scatter-PN. - *do j = 1, tallies(i) % n_user_score_bins* + *do J = 1, total number of moments* - **character(8) tallies(i) % moment_order(j)** + **/tallies/tally i/moments/orderJ** (*char[8]*) Tallying moment order for Legendre and spherical harmonic tally expansions (*e.g.*, 'P2', 'Y1,2', etc.). -**integer(4) source_present** +**/source_present** (*int*) Flag indicated if source bank is present in the file -**integer(4) n_realizations** +**/n_realizations** (*int*) Number of realizations for global tallies. -**integer(4) N_GLOBAL_TALLIES** +**/n_global_tallies** (*int*) - Number of global tally scores + Number of global tally scores. -*do i = 1, N_GLOBAL_TALLIES* +**/global_tallies** (Compound type) - **real(8) global_tallies(i) % sum** + Accumulated sum and sum-of-squares for each global tally. The compound type + has fields named ``sum`` and ``sum_sq``. - Accumulated sum for the i-th global tally - - **real(8) global_tallies(i) % sum_sq** - - Accumulated sum of squares for the i-th global tally - -**integer(4) tallies_on** +**tallies_present** (*int*) Flag indicated if tallies are present in the file. -if (tallies_on > 0) +*do i = 1, n_tallies* - *do i = 1, n_tallies* +**/tallies/tally i/results** (Compound type) - *do k = 1, size(tallies(i) % scores, 2)* - - *do j = 1, size(tallies(i) % scores, 1)* - - **real(8) tallies(i) % scores(j,k) % sum** - - Accumulated sum for the j-th score and k-th filter of the - i-th tally - - **real(8) tallies(i) % scores(j,k) % sum_sq** - - Accumulated sum of squares for the j-th score and k-th - filter of the i-th tally + Accumulated sum and sum-of-squares for each bin of the tally i-th tally if (run_mode == MODE_EIGENVALUE and source_present) - *do i = 1, n_particles* - - **real(8) source_bank(i) % wgt** - - Weight of the i-th source particle - - **real(8) source_bank(i) % xyz(1:3)** - - Coordinates of the i-th source particle. - - **real(8) source_bank(i) % uvw(1:3)** - - Direction of the i-th source particle - - **real(8) source_bank(i) % E** - - Energy of the i-th source particle. + **/source_bank** (Compound type) + Source bank information for each particle. The compound type has fields + ``wgt``, ``xyz``, ``uvw``, and ``E`` which represent the weight, + position, direction, and energy of the source particle, respectively. diff --git a/docs/source/quickinstall.rst b/docs/source/quickinstall.rst index b64dfebda..31ca71ffc 100644 --- a/docs/source/quickinstall.rst +++ b/docs/source/quickinstall.rst @@ -35,8 +35,8 @@ Installing from Source on Linux or Mac OS X ------------------------------------------- All OpenMC source code is hosted on GitHub_. If you have git_, the gfortran_ -compiler, and CMake_ installed, you can download and install OpenMC be entering -the following commands in a terminal: +compiler, CMake_, and HDF_ installed, you can download and install OpenMC be +entering the following commands in a terminal: .. code-block:: sh diff --git a/docs/source/usersguide/install.rst b/docs/source/usersguide/install.rst index 7d3cda173..7b8c6e3d4 100644 --- a/docs/source/usersguide/install.rst +++ b/docs/source/usersguide/install.rst @@ -59,6 +59,31 @@ Prerequisites sudo apt-get install cmake + * HDF5_ Library for portable binary output format + + OpenMC uses HDF5 for binary output files. As such, you will need to have + HDF5 installed on your computer. The installed version will need to have + been compiled with the same compiler you intend to compile OpenMC with. If + you are using HDF5 in conjunction with MPI, we recommend that your HDF5 + installation be built with parallel I/O features. An example of + configuring HDF5_ is listed below:: + + FC=/opt/mpich/3.1/bin/mpif90 CC=/opt/mpich/3.1/bin/mpicc \ + ./configure --prefix=/opt/hdf5/1.8.12 --enable-fortran \ + --enable-fortran2003 --enable-parallel + + You may omit ``--enable-parallel`` if you want to compile HDF5_ in serial. + + On Debian derivatives, HDF5 and/or parallel HDF5 can be installed through + the APT package manager: + + .. code-block:: sh + + sudo apt-get install libhdf5-8 libhdf5-dev hdf5-helpers + + Note that the exact package names may vary depending on your particular + distribution and version. + .. admonition:: Optional * An MPI implementation for distributed-memory parallel runs @@ -72,20 +97,6 @@ Prerequisites sudo apt-get install mpich libmpich-dev sudo apt-get install openmpi-bin libopenmpi1.6 libopenmpi-dev - * HDF5_ Library for portable binary output format - - To compile with support for HDF5_ output (highly recommended), you will - need to have HDF5 installed on your computer. The installed version will - need to have been compiled with the same compiler you intend to compile - OpenMC with. HDF5_ must be built with parallel I/O features if you intend - to use HDF5_ with MPI. An example of configuring HDF5_ is listed below:: - - FC=/opt/mpich/3.1/bin/mpif90 CC=/opt/mpich/3.1/bin/mpicc \ - ./configure --prefix=/opt/hdf5/1.8.12 --enable-fortran \ - --enable-fortran2003 --enable-parallel - - You may omit ``--enable-parallel`` if you want to compile HDF5_ in serial. - * git_ version control software for obtaining source code .. _gfortran: http://gcc.gnu.org/wiki/GFortran @@ -194,27 +205,26 @@ command, i.e. FC=mpif90 cmake /path/to/openmc -Compiling with HDF5 -+++++++++++++++++++ - -To compile with MPI, set the :envvar:`FC` environment variable to the path to -the HDF5 Fortran wrapper. For example, in a bash shell: +Selecting HDF5 Installation ++++++++++++++++++++++++++++ +CMakeLists.txt searches for the ``h5fc`` or ``h5pfc`` HDF5 Fortran wrapper on +your PATH environment variable and subsequently uses it to determine library +locations and compile flags. If you have multiple installations of HDF5 or one +that does not appear on your PATH, you can set the HDF5_ROOT environment +variable to the root directory of the HDF5 installation, e.g. .. code-block:: sh - export FC=h5fc + export HDF5_ROOT=/opt/hdf5/1.8.15 cmake /path/to/openmc -As noted above, an environment variable can typically be set for a single -command, i.e. +This will cause CMake to search first in /opt/hdf5/1.8.15/bin for ``h5fc`` / +``h5pfc`` before it searches elsewhere. As noted above, an environment variable +can typically be set for a single command, i.e. .. code-block:: sh - FC=h5fc cmake /path/to/openmc - -To compile with support for both MPI and HDF5, use the parallel HDF5 wrapper -``h5pfc`` instead. Note that this requires that your HDF5 installation be -compiled with ``--enable-parallel``. + HDF5_ROOT=/opt/hdf5/1.8.15 cmake /path/to/openmc Compiling on Linux and Mac OS X ------------------------------- From 7fdfc1ede40f60868cc2982537f14932c95e9c4b Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sat, 12 Sep 2015 13:43:57 +0700 Subject: [PATCH 23/32] Add particle restart file format in documentation. --- docs/source/devguide/index.rst | 1 + docs/source/devguide/particle_restart.rst | 59 +++++++++++++++++++++++ docs/source/devguide/statepoint.rst | 10 ++-- 3 files changed, 65 insertions(+), 5 deletions(-) create mode 100644 docs/source/devguide/particle_restart.rst diff --git a/docs/source/devguide/index.rst b/docs/source/devguide/index.rst index 03838363c..13dfc351f 100644 --- a/docs/source/devguide/index.rst +++ b/docs/source/devguide/index.rst @@ -17,5 +17,6 @@ as debugging. workflow xml-parsing statepoint + particle_restart voxel docbuild diff --git a/docs/source/devguide/particle_restart.rst b/docs/source/devguide/particle_restart.rst new file mode 100644 index 000000000..ecee81103 --- /dev/null +++ b/docs/source/devguide/particle_restart.rst @@ -0,0 +1,59 @@ +.. _devguide_particle_restart: + +============================ +Particle Restart File Format +============================ + +The current revision of the particle restart file format is 1. + +**/filetype** (*int*) + + Flags what type of file this is. A value of -1 indicates a statepoint file, + a value of -2 indicates a particle restart file, and a value of -3 indicates + a source file. + +**/revision** (*int*) + + Revision of the binary state point file. Any time a change is made in the + format of the state-point file, this integer is incremented. + +**/current_batch** (*int*) + + The number of batches already simulated. + +**/gen_per_batch** (*int*) + + Number of generations per batch. + +**/current_gen** (*int*) + + The number of generations already simulated. + +**/n_particles** (*int8_t*) + + Number of particles used per generation. + +**/run_mode** (*int*) + + Run mode used. A value of 1 indicates a fixed-source run and a value of 2 + indicates an eigenvalue run. + +**/id** (*int8_t*) + + Unique identifier of the particle. + +**/weight** (*double*) + + Weight of the particle. + +**/energy** (*double*) + + Energy of the particle in MeV. + +**/xyz** (*double[3]*) + + Position of the particle. + +**/uvw** (*double[3]*) + + Direction of the particle. diff --git a/docs/source/devguide/statepoint.rst b/docs/source/devguide/statepoint.rst index 7b0862056..de86c2254 100644 --- a/docs/source/devguide/statepoint.rst +++ b/docs/source/devguide/statepoint.rst @@ -1,10 +1,10 @@ .. _devguide_statepoint: -====================================== -State Point Binary File Specifications -====================================== +======================= +State Point File Format +======================= -The current revision of the statepoint binary file is 13. +The current revision of the statepoint file format is 13. **/filetype** (*int*) @@ -64,7 +64,7 @@ if (run_mode == MODE_EIGENVALUE) Number of inactive batches. - **gen_per_batch** (*int*) + **/gen_per_batch** (*int*) Number of generations per batch. From 1d774235aa3c610a65b07023b389056d1e6471d2 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 13 Sep 2015 11:29:18 +0700 Subject: [PATCH 24/32] Add documentation on track file format. --- docs/source/devguide/index.rst | 1 + docs/source/devguide/particle_restart.rst | 8 +++--- docs/source/devguide/statepoint.rst | 8 +++--- docs/source/devguide/track.rst | 32 +++++++++++++++++++++++ src/constants.F90 | 4 ++- src/track_output.F90 | 2 ++ 6 files changed, 46 insertions(+), 9 deletions(-) create mode 100644 docs/source/devguide/track.rst diff --git a/docs/source/devguide/index.rst b/docs/source/devguide/index.rst index 13dfc351f..3f87ecfad 100644 --- a/docs/source/devguide/index.rst +++ b/docs/source/devguide/index.rst @@ -18,5 +18,6 @@ as debugging. xml-parsing statepoint particle_restart + track voxel docbuild diff --git a/docs/source/devguide/particle_restart.rst b/docs/source/devguide/particle_restart.rst index ecee81103..bf6965558 100644 --- a/docs/source/devguide/particle_restart.rst +++ b/docs/source/devguide/particle_restart.rst @@ -9,13 +9,13 @@ The current revision of the particle restart file format is 1. **/filetype** (*int*) Flags what type of file this is. A value of -1 indicates a statepoint file, - a value of -2 indicates a particle restart file, and a value of -3 indicates - a source file. + a value of -2 indicates a particle restart file, a value of -3 indicates a + source file, and a value of -4 indicates a track file. **/revision** (*int*) - Revision of the binary state point file. Any time a change is made in the - format of the state-point file, this integer is incremented. + Revision of the particle restart file format. Any time a change is made in + the format, this integer is incremented. **/current_batch** (*int*) diff --git a/docs/source/devguide/statepoint.rst b/docs/source/devguide/statepoint.rst index de86c2254..82686ff67 100644 --- a/docs/source/devguide/statepoint.rst +++ b/docs/source/devguide/statepoint.rst @@ -9,13 +9,13 @@ The current revision of the statepoint file format is 13. **/filetype** (*int*) Flags what type of file this is. A value of -1 indicates a statepoint file, - a value of -2 indicates a particle restart file, and a value of -3 indicates - a source file. + a value of -2 indicates a particle restart file, a value of -3 indicates a + source file, and a value of -4 indicates a track file. **/revision** (*int*) - Revision of the binary state point file. Any time a change is made in the - format of the state-point file, this integer is incremented. + Revision of the state point file format. Any time a change is made in the + format, this integer is incremented. **/version_major** (*int*) diff --git a/docs/source/devguide/track.rst b/docs/source/devguide/track.rst new file mode 100644 index 000000000..afa27adfd --- /dev/null +++ b/docs/source/devguide/track.rst @@ -0,0 +1,32 @@ +.. _devguide_track: + +================= +Track File Format +================= + +The current revision of the particle track file format is 1. + +**/filetype** (*int*) + + Flags what type of file this is. A value of -1 indicates a statepoint file, + a value of -2 indicates a particle restart file, a value of -3 indicates a + source file, and a value of -4 indicates a track file. + +**/revision** (*int*) + + Revision of the track file format. Any time a change is made in the format, + this integer is incremented. + +**/n_particles** (*int*) + + Number of particles for which tracks are recorded. + +**/n_coords** (*int[]*) + + Number of coordinates for each particle. + +*do i = 1, n_particles* + + **/coordinates_i** (*double[][3]*) + + (x,y,z) coordinates for the *i*-th particle. diff --git a/src/constants.F90 b/src/constants.F90 index 38bedf022..9a89542af 100644 --- a/src/constants.F90 +++ b/src/constants.F90 @@ -13,12 +13,14 @@ module constants ! Revision numbers for binary files integer, parameter :: REVISION_STATEPOINT = 13 integer, parameter :: REVISION_PARTICLE_RESTART = 1 + integer, parameter :: REVISION_TRACK = 1 ! Binary file types integer, parameter :: & FILETYPE_STATEPOINT = -1, & FILETYPE_PARTICLE_RESTART = -2, & - FILETYPE_SOURCE = -3 + FILETYPE_SOURCE = -3, & + FILETYPE_TRACK = -4 ! ============================================================================ ! ADJUSTABLE PARAMETERS diff --git a/src/track_output.F90 b/src/track_output.F90 index d4b287800..f4018cde3 100644 --- a/src/track_output.F90 +++ b/src/track_output.F90 @@ -114,6 +114,8 @@ contains !$omp critical (FinalizeParticleTrack) file_id = file_create(fname) + call write_dataset(file_id, 'filetype', FILETYPE_TRACK) + call write_dataset(file_id, 'revision', REVISION_TRACK) call write_dataset(file_id, 'n_particles', n_particle_tracks) call write_dataset(file_id, 'n_coords', n_coords) do i = 1, n_particle_tracks From f13c4c7218103e7d7be9902ae8646e3f8ad95156 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 13 Sep 2015 11:36:55 +0700 Subject: [PATCH 25/32] Add source file format in documentation. --- docs/source/devguide/index.rst | 1 + docs/source/devguide/source.rst | 21 +++++++++++++++++++++ 2 files changed, 22 insertions(+) create mode 100644 docs/source/devguide/source.rst diff --git a/docs/source/devguide/index.rst b/docs/source/devguide/index.rst index 3f87ecfad..02015cfb4 100644 --- a/docs/source/devguide/index.rst +++ b/docs/source/devguide/index.rst @@ -17,6 +17,7 @@ as debugging. workflow xml-parsing statepoint + source particle_restart track voxel diff --git a/docs/source/devguide/source.rst b/docs/source/devguide/source.rst new file mode 100644 index 000000000..20457fb11 --- /dev/null +++ b/docs/source/devguide/source.rst @@ -0,0 +1,21 @@ +.. _devguide_source: + +================== +Source File Format +================== + +Normally, source data is stored in a state point file. However, it is possible +to request that the source be written separately, in which case the format used +is that documented here. + +**/filetype** (*int*) + + Flags what type of file this is. A value of -1 indicates a statepoint file, + a value of -2 indicates a particle restart file, a value of -3 indicates a + source file, and a value of -4 indicates a track file. + +**/source_bank** (Compound type) + + Source bank information for each particle. The compound type has fields + ``wgt``, ``xyz``, ``uvw``, and ``E`` which represent the weight, position, + direction, and energy of the source particle, respectively. From c2e8144a5672c4e1a7a1a7ac4f8906356ca071d1 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 13 Sep 2015 12:08:00 +0700 Subject: [PATCH 26/32] Move output file formats to user's guide. --- docs/source/devguide/index.rst | 4 ---- docs/source/usersguide/index.rst | 3 ++- docs/source/usersguide/output/index.rst | 14 ++++++++++++++ .../output}/particle_restart.rst | 2 +- .../{devguide => usersguide/output}/source.rst | 2 +- .../{devguide => usersguide/output}/statepoint.rst | 2 +- .../{devguide => usersguide/output}/track.rst | 2 +- docs/source/usersguide/processing.rst | 2 +- 8 files changed, 21 insertions(+), 10 deletions(-) create mode 100644 docs/source/usersguide/output/index.rst rename docs/source/{devguide => usersguide/output}/particle_restart.rst (97%) rename docs/source/{devguide => usersguide/output}/source.rst (96%) rename docs/source/{devguide => usersguide/output}/statepoint.rst (99%) rename docs/source/{devguide => usersguide/output}/track.rst (97%) diff --git a/docs/source/devguide/index.rst b/docs/source/devguide/index.rst index 02015cfb4..e73d8ba70 100644 --- a/docs/source/devguide/index.rst +++ b/docs/source/devguide/index.rst @@ -16,9 +16,5 @@ as debugging. styleguide workflow xml-parsing - statepoint - source - particle_restart - track voxel docbuild diff --git a/docs/source/usersguide/index.rst b/docs/source/usersguide/index.rst index 675ed4081..5a7e7addf 100644 --- a/docs/source/usersguide/index.rst +++ b/docs/source/usersguide/index.rst @@ -5,7 +5,7 @@ User's Guide ============ Welcome to the OpenMC User's Guide! This tutorial will guide you through the -essential aspects of using OpenMC to perform neutronic simulations. +essential aspects of using OpenMC to perform simulations. .. toctree:: :numbered: @@ -14,5 +14,6 @@ essential aspects of using OpenMC to perform neutronic simulations. beginners install input + output/index processing troubleshoot diff --git a/docs/source/usersguide/output/index.rst b/docs/source/usersguide/output/index.rst new file mode 100644 index 000000000..1eb85e9d5 --- /dev/null +++ b/docs/source/usersguide/output/index.rst @@ -0,0 +1,14 @@ +.. _usersguide_output: + +=================== +Output File Formats +=================== + +.. toctree:: + :numbered: + :maxdepth: 3 + + statepoint + source + particle_restart + track diff --git a/docs/source/devguide/particle_restart.rst b/docs/source/usersguide/output/particle_restart.rst similarity index 97% rename from docs/source/devguide/particle_restart.rst rename to docs/source/usersguide/output/particle_restart.rst index bf6965558..12ab3237f 100644 --- a/docs/source/devguide/particle_restart.rst +++ b/docs/source/usersguide/output/particle_restart.rst @@ -1,4 +1,4 @@ -.. _devguide_particle_restart: +.. _usersguide_particle_restart: ============================ Particle Restart File Format diff --git a/docs/source/devguide/source.rst b/docs/source/usersguide/output/source.rst similarity index 96% rename from docs/source/devguide/source.rst rename to docs/source/usersguide/output/source.rst index 20457fb11..cc8e71a67 100644 --- a/docs/source/devguide/source.rst +++ b/docs/source/usersguide/output/source.rst @@ -1,4 +1,4 @@ -.. _devguide_source: +.. _usersguide_source: ================== Source File Format diff --git a/docs/source/devguide/statepoint.rst b/docs/source/usersguide/output/statepoint.rst similarity index 99% rename from docs/source/devguide/statepoint.rst rename to docs/source/usersguide/output/statepoint.rst index 82686ff67..b17bdca02 100644 --- a/docs/source/devguide/statepoint.rst +++ b/docs/source/usersguide/output/statepoint.rst @@ -1,4 +1,4 @@ -.. _devguide_statepoint: +.. _usersguide_statepoint: ======================= State Point File Format diff --git a/docs/source/devguide/track.rst b/docs/source/usersguide/output/track.rst similarity index 97% rename from docs/source/devguide/track.rst rename to docs/source/usersguide/output/track.rst index afa27adfd..9a85ac7ea 100644 --- a/docs/source/devguide/track.rst +++ b/docs/source/usersguide/output/track.rst @@ -1,4 +1,4 @@ -.. _devguide_track: +.. _usersguide_track: ================= Track File Format diff --git a/docs/source/usersguide/processing.rst b/docs/source/usersguide/processing.rst index e773cf156..a6e9875ce 100644 --- a/docs/source/usersguide/processing.rst +++ b/docs/source/usersguide/processing.rst @@ -194,7 +194,7 @@ Data Extraction --------------- A great deal of information is available in statepoint files (See -:ref:`devguide_statepoint`), most of which is easily extracted by the provided +:ref:`usersguide_statepoint`), most of which is easily extracted by the provided utility statepoint.py. This utility provides a Python class to load statepoints and extract data - it is used in many of the provided plotting utilities, and can be used in user-created scripts to carry out manipulations of the data. To From b1f4597e2361baf6c8eac2085b26ad00418e0096 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 13 Sep 2015 12:08:18 +0700 Subject: [PATCH 27/32] unset a few variables in FindHDF5.cmake --- cmake/Modules/FindHDF5.cmake | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cmake/Modules/FindHDF5.cmake b/cmake/Modules/FindHDF5.cmake index 08ba0abaf..287e10e5b 100644 --- a/cmake/Modules/FindHDF5.cmake +++ b/cmake/Modules/FindHDF5.cmake @@ -136,6 +136,10 @@ find_program( HDF5_Fortran_COMPILER_EXECUTABLE DOC "HDF5 Fortran Wrapper compiler. Used only to detect HDF5 compile flags." ) mark_as_advanced( HDF5_Fortran_COMPILER_EXECUTABLE ) +unset(HDF5_C_COMPILER_NAMES) +unset(HDF5_CXX_COMPILER_NAMES) +unset(HDF5_Fortran_COMPILER_NAMES) + find_program( HDF5_DIFF_EXECUTABLE NAMES h5diff HINTS ENV HDF5_ROOT From 590df6e62d44fef5523b9707d7c8b3c5d157e5da Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Sun, 13 Sep 2015 12:20:58 +0700 Subject: [PATCH 28/32] Check that HDF5 groups are closed successfully. --- src/hdf5_interface.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/hdf5_interface.F90 b/src/hdf5_interface.F90 index f4771d848..5e0734648 100644 --- a/src/hdf5_interface.F90 +++ b/src/hdf5_interface.F90 @@ -236,6 +236,9 @@ contains integer :: hdf5_err ! HDF5 error code call h5gclose_f(group_id, hdf5_err) + if (hdf5_err < 0) then + call fatal_error("Unable to close HDF5 group.") + end if end subroutine close_group !=============================================================================== From 13113ca82000fa6ad86b5980424dc9e4d28e5f39 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Mon, 14 Sep 2015 10:48:19 +0700 Subject: [PATCH 29/32] Fixes in FindHDF5.cmake for Intel Xeon Phi. Before, -lz -ldl -lm -lrt would be turned into absolute paths. This doesn't work for the Xeon Phi where we need to cross-compile. The Intel compiler automatically adds the libraries with the correct architecture as long as -l arguments are passed as is. --- cmake/Modules/FindHDF5.cmake | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/cmake/Modules/FindHDF5.cmake b/cmake/Modules/FindHDF5.cmake index 287e10e5b..7492ea750 100644 --- a/cmake/Modules/FindHDF5.cmake +++ b/cmake/Modules/FindHDF5.cmake @@ -292,12 +292,8 @@ if( NOT HDF5_FOUND ) mark_as_advanced( HDF5_${LANGUAGE}_INCLUDE_DIR ) list( APPEND HDF5_INCLUDE_DIRS ${HDF5_${LANGUAGE}_INCLUDE_DIR} ) - set( HDF5_${LANGUAGE}_LIBRARY_NAMES - ${HDF5_${LANGUAGE}_LIBRARY_NAMES_INIT} - ${HDF5_${LANGUAGE}_LIBRARY_NAMES} ) - # find the HDF5 libraries - foreach( LIB ${HDF5_${LANGUAGE}_LIBRARY_NAMES} ) + foreach( LIB ${HDF5_${LANGUAGE}_LIBRARY_NAMES_INIT} ) if( UNIX AND HDF5_USE_STATIC_LIBRARIES ) # According to bug 1643 on the CMake bug tracker, this is the # preferred method for searching for a static library. @@ -325,6 +321,14 @@ if( NOT HDF5_FOUND ) endforeach() list( APPEND HDF5_LIBRARY_DIRS ${HDF5_${LANGUAGE}_LIBRARY_DIRS} ) + # When the wrapper lists a library with -l, e.g. -lz, simply use it as + # is. If find_library is called for these libraries, you end up with + # local libraries that will not be suitable when cross-compiling for the + # Intel Xeon Phi. + foreach(LIBNAME ${HDF5_${LANGUAGE}_LIBRARY_NAMES}) + list(APPEND HDF5_${LANGUAGE}_LIBRARIES "-l${LIBNAME}") + endforeach() + # Append the libraries for this language binding to the list of all # required libraries. list(APPEND HDF5_LIBRARIES ${HDF5_${LANGUAGE}_LIBRARIES}) From 6242b80c106a6db418486bf993a2dc10731b86ae Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Mon, 14 Sep 2015 15:32:49 +0700 Subject: [PATCH 30/32] Add installation instructions for the Xeon Phi. --- docs/source/quickinstall.rst | 2 +- docs/source/usersguide/install.rst | 19 +++++++++++++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/docs/source/quickinstall.rst b/docs/source/quickinstall.rst index 31ca71ffc..9ce752be7 100644 --- a/docs/source/quickinstall.rst +++ b/docs/source/quickinstall.rst @@ -35,7 +35,7 @@ Installing from Source on Linux or Mac OS X ------------------------------------------- All OpenMC source code is hosted on GitHub_. If you have git_, the gfortran_ -compiler, CMake_, and HDF_ installed, you can download and install OpenMC be +compiler, CMake_, and HDF5_ installed, you can download and install OpenMC be entering the following commands in a terminal: .. code-block:: sh diff --git a/docs/source/usersguide/install.rst b/docs/source/usersguide/install.rst index 7b8c6e3d4..dcf990bda 100644 --- a/docs/source/usersguide/install.rst +++ b/docs/source/usersguide/install.rst @@ -318,6 +318,25 @@ This will build an executable named ``openmc``. .. _MinGW: http://www.mingw.org .. _SourceForge: http://sourceforge.net/projects/mingw +Compiling for the Intel Xeon Phi +-------------------------------- + +In order to build OpenMC for the Intel Xeon Phi using the Intel Fortran +compiler, it is necessary to specify that all objects be compiled with the +``-mmic`` flag as follows: + +.. code-block:: sh + + mkdir build && cd build + FC=ifort FFLAGS=-mmic cmake -Dopenmp=on .. + make + +Note that unless an HDF5 build for the Intel Xeon Phi is already on your target +machine, you will need to cross-compile HDF5 for the Xeon Phi. An `example +script`_ to build zlib and HDF5 provides several necessary workarounds. + +.. _example script: https://github.com/paulromano/install-scripts/blob/master/install-hdf5-mic + Testing Build ------------- From f1b4e0ae7f2a806a4381dde286f44bd1765208a8 Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Mon, 14 Sep 2015 16:47:00 +0700 Subject: [PATCH 31/32] Avoid bug with PGI Fortran compiler. Apparently the PGI Fortran compiler (15.7) doesn't like variable names that are the same as module names. --- src/initialize.F90 | 36 ++++++++++++++++++------------------ src/state_point.F90 | 38 +++++++++++++++++++------------------- 2 files changed, 37 insertions(+), 37 deletions(-) diff --git a/src/initialize.F90 b/src/initialize.F90 index bd479032f..48985a718 100644 --- a/src/initialize.F90 +++ b/src/initialize.F90 @@ -930,7 +930,7 @@ contains integer :: i, j ! Tally, filter loop counters integer :: n_filt ! Number of filters originally in tally logical :: count_all ! Count all cells - type(TallyObject), pointer :: tally ! Current tally + type(TallyObject), pointer :: t ! Current tally type(Universe), pointer :: univ ! Pointer to universe type(Cell), pointer :: c ! Pointer to cell integer, allocatable :: univ_list(:) ! Target offsets @@ -943,18 +943,18 @@ contains do i = 1, n_tallies ! Get pointer to tally - tally => tallies(i) + t => tallies(i) - n_filt = tally%n_filters + n_filt = t%n_filters ! Loop over the filters to determine how many additional filters ! need to be added to this tally - do j = 1, tally%n_filters + do j = 1, t%n_filters ! Determine type of filter - if (tally%filters(j)%type == FILTER_DISTRIBCELL) then + if (t%filters(j)%type == FILTER_DISTRIBCELL) then count_all = .true. - if (size(tally%filters(j)%int_bins) > 1) then + if (size(t%filters(j)%int_bins) > 1) then call fatal_error("A distribcell filter was specified with & &multiple bins. This feature is not supported.") end if @@ -975,15 +975,15 @@ contains do i = 1, n_tallies ! Get pointer to tally - tally => tallies(i) + t => tallies(i) ! Initialize the filters - do j = 1, tally%n_filters + do j = 1, t%n_filters ! Set the number of bins to the number of instances of the cell - if (tally%filters(j)%type == FILTER_DISTRIBCELL) then - c => cells(tally%filters(j)%int_bins(1)) - tally%filters(j)%n_bins = c%instances + if (t%filters(j)%type == FILTER_DISTRIBCELL) then + c => cells(t%filters(j)%int_bins(1)) + t%filters(j)%n_bins = c%instances end if end do @@ -1024,7 +1024,7 @@ contains type(SetInt) :: cell_list ! distribells to track type(Universe), pointer :: univ ! pointer to universe class(Lattice), pointer :: lat ! pointer to lattice - type(TallyObject), pointer :: tally ! pointer to tally + type(TallyObject), pointer :: t ! pointer to tally type(TallyFilter), pointer :: filter ! pointer to filter ! Begin gathering list of cells in distribcell tallies @@ -1032,10 +1032,10 @@ contains ! Populate list of distribcells to track do i = 1, n_tallies - tally => tallies(i) + t => tallies(i) - do j = 1, tally%n_filters - filter => tally%filters(j) + do j = 1, t%n_filters + filter => t%filters(j) if (filter%type == FILTER_DISTRIBCELL) then if (.not. cell_list%contains(filter%int_bins(1))) then @@ -1079,10 +1079,10 @@ contains ! Loop over all tallies do l = 1, n_tallies - tally => tallies(l) + t => tallies(l) - do m = 1, tally%n_filters - filter => tally%filters(m) + do m = 1, t%n_filters + filter => t%filters(m) ! Loop over only distribcell filters ! If filter points to cell we just found, set offset index diff --git a/src/state_point.F90 b/src/state_point.F90 index 7688d5d33..691d0567e 100644 --- a/src/state_point.F90 +++ b/src/state_point.F90 @@ -52,7 +52,7 @@ contains integer(HID_T) :: filter_group, moments_group character(8) :: moment_name ! name of moment (e.g, P3) character(MAX_FILE_LEN) :: filename - type(StructuredMesh), pointer :: mesh + type(StructuredMesh), pointer :: meshp type(TallyObject), pointer :: tally type(ElemKeyValueII), pointer :: current type(ElemKeyValueII), pointer :: next @@ -166,16 +166,16 @@ contains ! Write information for meshes MESH_LOOP: do i = 1, n_meshes - mesh => meshes(id_array(i)) - mesh_group = create_group(meshes_group, "mesh " // trim(to_str(mesh%id))) + meshp => meshes(id_array(i)) + mesh_group = create_group(meshes_group, "mesh " // trim(to_str(meshp%id))) - call write_dataset(mesh_group, "id", mesh%id) - call write_dataset(mesh_group, "type", mesh%type) - call write_dataset(mesh_group, "n_dimension", mesh%n_dimension) - call write_dataset(mesh_group, "dimension", mesh%dimension) - call write_dataset(mesh_group, "lower_left", mesh%lower_left) - call write_dataset(mesh_group, "upper_right", mesh%upper_right) - call write_dataset(mesh_group, "width", mesh%width) + call write_dataset(mesh_group, "id", meshp%id) + call write_dataset(mesh_group, "type", meshp%type) + call write_dataset(mesh_group, "n_dimension", meshp%n_dimension) + call write_dataset(mesh_group, "dimension", meshp%dimension) + call write_dataset(mesh_group, "lower_left", meshp%lower_left) + call write_dataset(mesh_group, "upper_right", meshp%upper_right) + call write_dataset(mesh_group, "width", meshp%width) call close_group(mesh_group) end do MESH_LOOP @@ -600,7 +600,7 @@ contains character(MAX_FILE_LEN) :: path_temp character(19) :: current_time character(8) :: moment_name ! name of moment (e.g, P3, Y-1,1) - type(StructuredMesh), pointer :: mesh + type(StructuredMesh), pointer :: meshp type(TallyObject), pointer :: tally ! Write message @@ -718,18 +718,18 @@ contains ! Read and overwrite mesh information MESH_LOOP: do i = 1, n_meshes - mesh => meshes(id_array(i)) + meshp => meshes(id_array(i)) curr_key = key_array(id_array(i)) mesh_group = open_group(meshes_group, "mesh " // & trim(to_str(curr_key))) - call read_dataset(mesh_group, "id", mesh%id) - call read_dataset(mesh_group, "type", mesh%type) - call read_dataset(mesh_group, "n_dimension", mesh%n_dimension) - call read_dataset(mesh_group, "dimension", mesh%dimension) - call read_dataset(mesh_group, "lower_left", mesh%lower_left) - call read_dataset(mesh_group, "upper_right", mesh%upper_right) - call read_dataset(mesh_group, "width", mesh%width) + call read_dataset(mesh_group, "id", meshp%id) + call read_dataset(mesh_group, "type", meshp%type) + call read_dataset(mesh_group, "n_dimension", meshp%n_dimension) + call read_dataset(mesh_group, "dimension", meshp%dimension) + call read_dataset(mesh_group, "lower_left", meshp%lower_left) + call read_dataset(mesh_group, "upper_right", meshp%upper_right) + call read_dataset(mesh_group, "width", meshp%width) call close_group(mesh_group) end do MESH_LOOP From 63a378bd93fb10f343e21062bad3f4c4cc63d72c Mon Sep 17 00:00:00 2001 From: Paul Romano Date: Mon, 14 Sep 2015 20:36:51 +0700 Subject: [PATCH 32/32] Make sure -L flags from HDF5 wrapper are passed --- CMakeLists.txt | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 76c099d52..36501c918 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -262,6 +262,11 @@ else() target_compile_options(${program} PUBLIC ${f90flags}) endif() +# Add HDF5 library directories to link line with -L +foreach(LIBDIR ${HDF5_LIBRARY_DIRS}) + list(APPEND ldflags "-L${LIBDIR}") +endforeach() + # target_link_libraries treats any arguments starting with - but not -l as # linker flags. Thus, we can pass both linker flags and libraries together. target_link_libraries(${program} ${ldflags} ${HDF5_LIBRARIES} fox_dom)