define_problem_discretization Submodule


Uses

  • module~~define_problem_discretization~~UsesGraph module~define_problem_discretization define_problem_discretization module~kind_parameters kind_parameters module~define_problem_discretization->module~kind_parameters module~assertions_interface assertions_interface module~define_problem_discretization->module~assertions_interface iso_fortran_env iso_fortran_env module~define_problem_discretization->iso_fortran_env module~problem_discretization_interface problem_discretization_interface module~define_problem_discretization->module~problem_discretization_interface module~kind_parameters->iso_fortran_env module~problem_discretization_interface->module~kind_parameters module~cylinder_2d_interface cylinder_2d_interface module~problem_discretization_interface->module~cylinder_2d_interface module~surfaces_interface surfaces_interface module~problem_discretization_interface->module~surfaces_interface module~sphere_1d_interface sphere_1d_interface module~problem_discretization_interface->module~sphere_1d_interface module~differentiable_field_interface differentiable_field_interface module~problem_discretization_interface->module~differentiable_field_interface module~package_interface package_interface module~problem_discretization_interface->module~package_interface module~plate_3d_interface plate_3d_interface module~problem_discretization_interface->module~plate_3d_interface module~structured_grid_interface structured_grid_interface module~problem_discretization_interface->module~structured_grid_interface module~geometry_interface geometry_interface module~problem_discretization_interface->module~geometry_interface module~object_interface object_interface module~problem_discretization_interface->module~object_interface module~cylinder_2d_interface->module~kind_parameters module~cylinder_2d_interface->module~geometry_interface json_module json_module module~cylinder_2d_interface->json_module module~block_metadata_interface block_metadata_interface module~cylinder_2d_interface->module~block_metadata_interface module~surfaces_interface->module~kind_parameters module~surfaces_interface->module~package_interface iso_c_binding iso_c_binding module~surfaces_interface->iso_c_binding module~sphere_1d_interface->module~kind_parameters module~sphere_1d_interface->module~geometry_interface module~sphere_1d_interface->json_module module~sphere_1d_interface->module~block_metadata_interface module~grid_interface grid_interface module~differentiable_field_interface->module~grid_interface module~package_interface->module~kind_parameters module~plate_3d_interface->module~kind_parameters module~plate_3d_interface->module~geometry_interface module~plate_3d_interface->json_module module~plate_3d_interface->module~block_metadata_interface module~structured_grid_interface->module~kind_parameters module~structured_grid_interface->module~surfaces_interface module~structured_grid_interface->module~differentiable_field_interface module~structured_grid_interface->module~geometry_interface module~structured_grid_interface->module~grid_interface module~structured_grid_interface->module~block_metadata_interface module~grid_interface->module~object_interface module~units_interface units_interface module~grid_interface->module~units_interface module~block_metadata_interface->module~kind_parameters module~block_metadata_interface->iso_c_binding module~units_interface->module~object_interface

Contents


Variables

TypeVisibility AttributesNameInitial
integer, private, parameter:: success =0

Functions

pure function evenly_spaced_points(boundaries, resolution, direction) result(grid_nodes)

Define grid point coordinates with uniform spacing in the chosen block

Arguments

Type IntentOptional AttributesName
real(kind=r8k), intent(in) :: boundaries(:,:)

block boundaries of each coordinate direction

integer(kind=i4k), intent(in) :: resolution(:)

number of grid points in each direction

integer(kind=i4k), intent(in) :: direction

coordinate direction to define

Return Value real(kind=r8k), allocatable, (:,:,:)

grid node locations and spacing in each coordination direction

pure function first_block(image, num_blocks) result(block_id)

Arguments

Type IntentOptional AttributesName
integer, intent(in) :: image
integer, intent(in) :: num_blocks

Return Value integer

pure function last_block(image, num_blocks) result(block_id)

Arguments

Type IntentOptional AttributesName
integer, intent(in) :: image
integer, intent(in) :: num_blocks

Return Value integer

pure function overflow(image, remainder) result(filler)

Arguments

Type IntentOptional AttributesName
integer, intent(in) :: image
integer, intent(in) :: remainder

Return Value integer


Subroutines

subroutine csv_output(this, filename, iostat)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this
character(len=*), intent(in) :: filename
integer, intent(inout), optional :: iostat

subroutine define_scalar(s, vals, dataname)

Arguments

Type IntentOptional AttributesName
class(attributes), intent(inout) :: s
real(kind=r8k), intent(in) :: vals(:)
character(len=*), intent(in) :: dataname

subroutine vtk_output(this, filename, iostat)

4D array of nodal position vectors shape of 1st 3 dims specifies # points in ea. direction 8-element array of block-local IDs for voxel corners

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this
character(len=*), intent(in), optional :: filename
integer, intent(out) :: iostat

Module Procedures

module procedure block_identifier pure module function block_identifier(this, ijk) result(n)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this
integer, intent(in) :: ijk(:)

Return Value integer

module procedure block_indicial_coordinates pure module function block_indicial_coordinates(this, n) result(ijk)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this
integer, intent(in) :: n

Return Value integer, dimension(:), allocatable, (:)

module procedure block_load pure module function block_load(this) result(num_blocks)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this

Return Value integer

module procedure get_block_surfaces module function get_block_surfaces(this) result(this_block_surfaces)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this

Return Value type(surfaces)

module procedure get_global_block_shape module function get_global_block_shape(this) result(block_shape)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this

Return Value integer, dimension(:), allocatable

module procedure get_surface_packages module function get_surface_packages(this) result(this_surface_packages)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this

Return Value type(package), allocatable, dimension(:,:,:)

module procedure initialize_from_cylinder_2d module subroutine initialize_from_cylinder_2d(this, cylinder_2d_geometry)

partition a block-structured grids across images

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(inout) :: this
type(cylinder_2d), intent(in) :: cylinder_2d_geometry

module procedure initialize_from_plate_3d module subroutine initialize_from_plate_3d(this, plate_3d_geometry)

partition a block-structured grids across images

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(inout) :: this
type(plate_3d), intent(in) :: plate_3d_geometry

module procedure initialize_from_sphere_1d module subroutine initialize_from_sphere_1d(this, sphere_1d_geometry)

partition a block-structured grids across images

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(inout) :: this
type(sphere_1d), intent(in) :: sphere_1d_geometry

module procedure my_blocks pure module function my_blocks(this) result(block_identifier_range)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this

Return Value integer (num_bounds)

module procedure num_scalar_flux_divergences pure module function num_scalar_flux_divergences(this) result(num_divergences)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this

Return Value integer

module procedure num_scalars pure module function num_scalars(this) result(num_scalar_fields)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this

Return Value integer

module procedure partition module subroutine partition(this, global_block_shape, prototype)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(inout) :: this
integer, intent(in) :: global_block_shape(:)
class(structured_grid), intent(in) :: prototype

module procedure set_analytical_scalars module subroutine set_analytical_scalars(this, scalar_setters)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(inout) :: this
class(differentiable_field), intent(in), dimension(:):: scalar_setters

module procedure set_scalar_flux_divergence module subroutine set_scalar_flux_divergence(this, exact_result)

the above loop sets normal-flux data just inside each block boundary for communication in the loop below

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(inout) :: this
class(differentiable_field), intent(in), optional dimension(:):: exact_result

module procedure solve_governing_equations module subroutine solve_governing_equations(this, duration)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this
real(kind=r8k), intent(in) :: duration

module procedure user_defined_vertices module subroutine user_defined_vertices(this, x_nodes, y_nodes, z_nodes, block_identifier)

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(inout) :: this
real(kind=r8k), intent(in) :: x_nodes(:,:,:)
real(kind=r8k), intent(in) :: y_nodes(:,:,:)
real(kind=r8k), intent(in) :: z_nodes(:,:,:)
integer, intent(in) :: block_identifier

module procedure write_output module subroutine write_output(this, filename)

Author
Ian Porter
Date
11/25/2019

This is a generic procedure for writing output files. This procedure eliminates the DTIO to allow for linking to external libraries that handle all of the file output

Arguments

Type IntentOptional AttributesName
class(problem_discretization), intent(in) :: this
character(len=*), intent(in) :: filename