diff --git a/CMakeLists.txt b/CMakeLists.txt index 6bc51e8128..1c0cab1dc0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -336,7 +336,6 @@ add_library(libopenmc SHARED src/state_point.F90 src/stl_vector.F90 src/string.F90 - src/surface_header.F90 src/track_output.F90 src/vector_header.F90 src/xml_interface.F90 diff --git a/src/api.F90 b/src/api.F90 index c1d934e36d..c4c47ee00e 100644 --- a/src/api.F90 +++ b/src/api.F90 @@ -64,7 +64,6 @@ contains use photon_header use settings use simulation_header - use surface_header use tally_filter_header use tally_header @@ -90,6 +89,9 @@ contains subroutine free_memory_volume() bind(C) end subroutine + subroutine free_memory_surfaces() bind(C) + end subroutine + subroutine sab_clear() bind(C) end subroutine end interface diff --git a/src/geometry.F90 b/src/geometry.F90 index 02ababae68..0abe96ee49 100644 --- a/src/geometry.F90 +++ b/src/geometry.F90 @@ -5,8 +5,6 @@ module geometry use particle_header use simulation_header use settings - use surface_header - use string, only: to_str use, intrinsic :: ISO_C_BINDING diff --git a/src/input_xml.F90 b/src/input_xml.F90 index 238bb7302c..ccdf142f20 100644 --- a/src/input_xml.F90 +++ b/src/input_xml.F90 @@ -19,7 +19,6 @@ module input_xml use nuclide_header use photon_header use random_lcg, only: prn - use surface_header use settings use stl_vector, only: VectorInt, VectorReal, VectorChar use string, only: to_lower, to_str, str_to_int, & @@ -116,7 +115,6 @@ contains call write_message("Reading DAGMC geometry...", 5) call load_dagmc_geometry() - call allocate_surfaces() call allocate_cells() ! setup universe data structs @@ -153,7 +151,6 @@ contains integer :: n_cells_in_univ real(8) :: phi, theta, psi logical :: file_exists - logical :: boundary_exists character(MAX_LINE_LEN) :: filename type(Cell), pointer :: c type(XMLDocument) :: doc @@ -188,28 +185,8 @@ contains ! ========================================================================== ! READ SURFACES FROM GEOMETRY.XML - ! This variable is used to check whether at least one boundary condition was - ! applied to a surface - boundary_exists = .false. - call read_surfaces(root % ptr) - ! Allocate surfaces array - allocate(surfaces(surfaces_size())) - do i = 1, size(surfaces) - surfaces(i) % ptr = surface_pointer(i - 1); - - if (surfaces(i) % bc() /= BC_TRANSMIT) boundary_exists = .true. - end do - - ! Check to make sure a boundary condition was applied to at least one - ! surface - if (run_mode /= MODE_PLOTTING) then - if (.not. boundary_exists) then - call fatal_error("No boundary conditions were applied to any surfaces!") - end if - end if - ! ========================================================================== ! READ CELLS FROM GEOMETRY.XML @@ -316,18 +293,6 @@ contains end subroutine read_geometry_xml - subroutine allocate_surfaces() - integer :: i - - ! Allocate surfaces array - allocate(surfaces(surfaces_size())) - - do i = 1, size(surfaces) - surfaces(i) % ptr = surface_pointer(i - 1); - end do - - end subroutine allocate_surfaces - subroutine allocate_cells() integer :: i type(Cell), pointer :: c diff --git a/src/surface.cpp b/src/surface.cpp index 8b9b20ea15..0cceee9f4f 100644 --- a/src/surface.cpp +++ b/src/surface.cpp @@ -7,8 +7,9 @@ #include "openmc/error.h" #include "openmc/hdf5_interface.h" -#include "openmc/xml_interface.h" +#include "openmc/settings.h" #include "openmc/string_utils.h" +#include "openmc/xml_interface.h" namespace openmc { @@ -1243,59 +1244,30 @@ read_surfaces(pugi::xml_node* node) } } } + + // Check to make sure a boundary condition was applied to at least one + // surface + bool boundary_exists = false; + for (const auto& surf : model::surfaces) { + if (surf->bc_ != BC_TRANSMIT) { + boundary_exists = true; + break; + } + } + if (settings::run_mode != RUN_MODE_PLOTTING && !boundary_exists) { + fatal_error("No boundary conditions were applied to any surfaces!"); + } } //============================================================================== // Fortran compatibility functions //============================================================================== -extern "C" { - Surface* surface_pointer(int surf_ind) {return model::surfaces[surf_ind];} - - int surface_id(Surface* surf) {return surf->id_;} - - int surface_bc(Surface* surf) {return surf->bc_;} - - void surface_reflect(Surface* surf, double xyz[3], double uvw[3]) - { - Position r {xyz}; - Direction u {uvw}; - u = surf->reflect(r, u); - - uvw[0] = u.x; - uvw[1] = u.y; - uvw[2] = u.z; - } - - int surface_i_periodic(PeriodicSurface* surf) {return surf->i_periodic_;} - - bool - surface_periodic(PeriodicSurface* surf, PeriodicSurface* other, double xyz[3], - double uvw[3]) - { - Position r {xyz}; - Direction u {uvw}; - bool rotational = surf->periodic_translate(other, r, u); - - // Copy back to arrays - xyz[0] = r.x; - xyz[1] = r.y; - xyz[2] = r.z; - uvw[0] = u.x; - uvw[1] = u.y; - uvw[2] = u.z; - - return rotational; - } - - void free_memory_surfaces_c() - { - for (Surface* surf : model::surfaces) {delete surf;} - model::surfaces.clear(); - model::surface_map.clear(); - } - - int surfaces_size() { return model::surfaces.size(); } +extern "C" void free_memory_surfaces() +{ + for (Surface* surf : model::surfaces) {delete surf;} + model::surfaces.clear(); + model::surface_map.clear(); } } // namespace openmc diff --git a/src/surface_header.F90 b/src/surface_header.F90 deleted file mode 100644 index 17f9515f37..0000000000 --- a/src/surface_header.F90 +++ /dev/null @@ -1,135 +0,0 @@ -module surface_header - - use, intrinsic :: ISO_C_BINDING - - use hdf5_interface - - implicit none - - interface - pure function surface_pointer(surf_ind) bind(C) result(ptr) - use ISO_C_BINDING - implicit none - integer(C_INT), intent(in), value :: surf_ind - type(C_PTR) :: ptr - end function surface_pointer - - pure function surface_id_c(surf_ptr) bind(C, name='surface_id') result(id) - use ISO_C_BINDING - implicit none - type(C_PTR), intent(in), value :: surf_ptr - integer(C_INT) :: id - end function surface_id_c - - pure function surface_bc_c(surf_ptr) bind(C, name='surface_bc') result(bc) - use ISO_C_BINDING - implicit none - type(C_PTR), intent(in), value :: surf_ptr - integer(C_INT) :: bc - end function surface_bc_c - - pure subroutine surface_reflect_c(surf_ptr, xyz, uvw) & - bind(C, name='surface_reflect') - use ISO_C_BINDING - implicit none - type(C_PTR), intent(in), value :: surf_ptr - real(C_DOUBLE), intent(in) :: xyz(3); - real(C_DOUBLE), intent(inout) :: uvw(3); - end subroutine surface_reflect_c - - pure function surface_i_periodic_c(surf_ptr) & - bind(C, name="surface_i_periodic") result(i_periodic) - use ISO_C_BINDING - implicit none - type(C_PTR), intent(in), value :: surf_ptr - integer(C_INT) :: i_periodic - end function surface_i_periodic_c - - function surface_periodic_c(surf_ptr, other_ptr, xyz, uvw) & - bind(C, name="surface_periodic") result(rotational) - use ISO_C_BINDING - implicit none - type(C_PTR), intent(in), value :: surf_ptr - type(C_PTR), intent(in), value :: other_ptr - real(C_DOUBLE), intent(inout) :: xyz(3); - real(C_DOUBLE), intent(inout) :: uvw(3); - logical(C_BOOL) :: rotational - end function surface_periodic_c - - subroutine free_memory_surfaces_c() bind(C) - end subroutine free_memory_surfaces_c - end interface - -!=============================================================================== -! SURFACE type defines a first- or second-order surface that can be used to -! construct closed volumes (cells) -!=============================================================================== - - type :: Surface - type(C_PTR) :: ptr - - contains - - procedure :: id => surface_id - procedure :: bc => surface_bc - procedure :: reflect => surface_reflect - procedure :: i_periodic => surface_i_periodic - procedure :: periodic_translate => surface_periodic - - end type Surface - - type(Surface), allocatable, target :: surfaces(:) - - interface - function surfaces_size() result(sz) bind(C) - import C_INT - integer(C_INT) :: sz - end function - end interface - -contains - - pure function surface_id(this) result(id) - class(Surface), intent(in) :: this - integer(C_INT) :: id - id = surface_id_c(this % ptr) - end function surface_id - - pure function surface_bc(this) result(bc) - class(Surface), intent(in) :: this - integer(C_INT) :: bc - bc = surface_bc_c(this % ptr) - end function surface_bc - - pure subroutine surface_reflect(this, xyz, uvw) - class(Surface), intent(in) :: this - real(C_DOUBLE), intent(in) :: xyz(3); - real(C_DOUBLE), intent(inout) :: uvw(3); - call surface_reflect_c(this % ptr, xyz, uvw) - end subroutine surface_reflect - - pure function surface_i_periodic(this) result(i_periodic) - class(Surface), intent(in) :: this - integer(C_INT) :: i_periodic - i_periodic = surface_i_periodic_c(this % ptr) - end function surface_i_periodic - - function surface_periodic(this, other, xyz, uvw) result(rotational) - class(Surface), intent(in) :: this - class(Surface), intent(in) :: other - real(C_DOUBLE), intent(inout) :: xyz(3); - real(C_DOUBLE), intent(inout) :: uvw(3); - logical(C_BOOL) :: rotational - rotational = surface_periodic_c(this % ptr, other % ptr, xyz, uvw) - end function surface_periodic - -!=============================================================================== -! FREE_MEMORY_SURFACES deallocates global arrays defined in this module -!=============================================================================== - - subroutine free_memory_surfaces() - if (allocated(surfaces)) deallocate(surfaces) - call free_memory_surfaces_c() - end subroutine free_memory_surfaces - -end module surface_header