diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 73fa638ef..48f4ca0c4 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -1,4 +1,15 @@ repos: + - repo: https://github.com/pre-commit/pre-commit-hooks + rev: v5.0.0 + hooks: + - id: check-yaml + - id: end-of-file-fixer + - id: trailing-whitespace + - repo: https://github.com/psf/black-pre-commit-mirror + rev: 25.1.0 + hooks: + - id: black + language_version: python3 - repo: local hooks: - id: fprettify diff --git a/CMakeLists.txt b/CMakeLists.txt index e63bdea3a..45e93fa49 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,28 +1,28 @@ -# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -# +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +# # Maintainers : support@fluidnumerics.com # Official Repository : https://github.com/FluidNumerics/self/ -# +# # Copyright © 2024 Fluid Numerics LLC -# +# # Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -# +# # 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -# +# # 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in # the documentation and/or other materials provided with the distribution. -# +# # 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from # this software without specific prior written permission. -# +# # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT # HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -# -# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +# +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// cmake_minimum_required(VERSION 3.21) cmake_policy(VERSION 3.21...3.27) @@ -38,6 +38,7 @@ option(SELF_ENABLE_EXAMPLES "Option to enable build of examples. (Default On)" option(SELF_ENABLE_GPU "Option to enable GPU backend. Requires either CUDA or HIP. (Default Off)" OFF) option(SELF_ENABLE_APU "Option to enable APU backend. Requires either CUDA or HIP. (Default Off)" OFF) option(SELF_ENABLE_DOUBLE_PRECISION "Option to enable double precision for floating point arithmetic. (Default On)" ON) +option(SELF_ENABLE_INTERFACE "Option to enable Python interface. (Default Off)" OFF) set(SELF_MPIEXEC_NUMPROCS "2" CACHE STRING "The number of MPI ranks to use to launch MPI tests. Only used when launching test programs via ctest.") set(SELF_MPIEXEC_OPTIONS "" CACHE STRING "Any additional options, such as binding options, to use for MPI tests.Only used when launching test programs via ctest. Defaults to nothing") @@ -54,7 +55,7 @@ FortranCInterface_VERIFY() if(NOT FortranCInterface_VERIFIED_C) message(FATAL_ERROR "Fortran compiler must support C Interface") endif(NOT FortranCInterface_VERIFIED_C) - + if(NOT CMAKE_Fortran_COMPILER_SUPPORTS_F90) MESSAGE(FATAL_ERROR "Fortran compiler does not support F90") endif(NOT CMAKE_Fortran_COMPILER_SUPPORTS_F90) @@ -131,11 +132,6 @@ find_package(MPI COMPONENTS Fortran C REQUIRED) # HDF5 : See https://cmake.org/cmake/help/latest/module/FindHDF5.html find_package(HDF5 REQUIRED Fortran) -# # JSON-Fortran -# find_library(JSONFORTRAN_LIBRARIES NAMES jsonfortran REQUIRED) -# find_path(JSONFORTRAN_INCLUDE_DIRS json_module.mod) - - # FEQ-Parse find_library(FEQPARSE_LIBRARIES NAMES feqparse REQUIRED) find_path(FEQPARSE_INCLUDE_DIRS feqparse.mod) @@ -225,19 +221,23 @@ endif() # Libraries add_subdirectory(${CMAKE_SOURCE_DIR}/src) -# link_directories(${CMAKE_BINARY_DIR}/src) + +if(SELF_ENABLE_INTERFACE) + # JSON-Fortran + find_library(JSONFORTRAN_LIBRARIES NAMES jsonfortran REQUIRED) + find_path(JSONFORTRAN_INCLUDE_DIRS json_module.mod) + add_subdirectory(${CMAKE_SOURCE_DIR}/src/python) +endif() if(SELF_ENABLE_TESTING) enable_testing() add_subdirectory(${CMAKE_SOURCE_DIR}/test) - if(SELF_ENABLE_EXAMPLES) - add_subdirectory(${CMAKE_SOURCE_DIR}/examples) - endif() -else() - if(SELF_ENABLE_EXAMPLES) - enable_testing() - add_subdirectory(${CMAKE_SOURCE_DIR}/examples) - endif() +endif() + +if(SELF_ENABLE_EXAMPLES) + add_subdirectory(${CMAKE_SOURCE_DIR}/examples) endif() +# Share / etc resources +install(DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/share DESTINATION ${CMAKE_INSTALL_PREFIX}) diff --git a/docs/MeshGeneration/BoundaryConditions.md b/docs/MeshGeneration/BoundaryConditions.md new file mode 100644 index 000000000..2bb28a51c --- /dev/null +++ b/docs/MeshGeneration/BoundaryConditions.md @@ -0,0 +1,5 @@ +# Boundary Conditions + +In most mesh generation software, you are given the ability to align a name (string/character) and an integer id with each face, node, or edge that lies on a physical boundary. This information is often used in physical modeling software, like SELF, to implement the appropriate boundary conditions for your model. SELF provides a flexible framework for mapping boundary condition names and integer ids to procedures that you can implement for specific boundary conditions. This section of the documentation provides an overview of how you can register custom boundary conditions for a model built with SELF. Additionally we'll cover how you will want to register boundary conditions in a way that is consistent with the meshes that you create in other external software (e.g. HOHQMesh). + +## How boundary conditions are registered in SELF diff --git a/examples/linear_shallow_water2d_kelvinwaves.py b/examples/linear_shallow_water2d_kelvinwaves.py new file mode 100644 index 000000000..ba385ab59 --- /dev/null +++ b/examples/linear_shallow_water2d_kelvinwaves.py @@ -0,0 +1,59 @@ +from pyself.interface import SelfModel +from pyself.config import SelfModelConfig +import os +from datetime import datetime + + +pwd = os.path.dirname(os.path.abspath(__file__)) +# Set the case directory to a new unique directory based in the time stamp +# get current working directory + +case_directory = f"{os.getcwd()}/kelvinwaves-{datetime.now().strftime('%Y%m%d-%H%M%S')}" + + +def configure_geometry(config): + # Configure geometry + config.set_parameter( + "geometry", "mesh_file", f"{pwd}/../share/mesh/Circle/Circle_mesh.h5" + ) + config.set_parameter("geometry", "uniform_boundary_condition", "no_normal_flow") + config.set_parameter("geometry", "control_degree", 7) + config.set_parameter("geometry", "control_quadrature", "gauss") + + +def configure_time_options(config): + # Configure time options + config.set_parameter("time_options", "integrator", "euler") + config.set_parameter("time_options", "dt", 0.0025) + config.set_parameter("time_options", "start_time", 0.0) + config.set_parameter("time_options", "duration", 1.0) + config.set_parameter("time_options", "io_interval", 0.05) + config.set_parameter("time_options", "update_interval", 50) + + +def configure_shallow_water(config): + # Configure shallow water parameters + config.set_parameter("linear-shallow-water-2d", "g", 1.0) + config.set_parameter("linear-shallow-water-2d", "H", 1.0) + config.set_parameter("linear-shallow-water-2d", "Cd", 0.25) + config.set_parameter("linear-shallow-water-2d", "f0", 10.0) + config.set_parameter("linear-shallow-water-2d", "beta", 0.0) + + +def main(): + + config = SelfModelConfig(case_directory=case_directory) + config.config["model_name"] = "linear-shallow-water-2d" + + configure_geometry(config) + configure_time_options(config) + configure_shallow_water(config) + + # Create the model + model = SelfModel(config=config) + + x, y = model.get_coordinates() + + +if __name__ == "__main__": + main() diff --git a/pyself/__init__.py b/pyself/__init__.py index bf2f64cea..864bb2fb4 100644 --- a/pyself/__init__.py +++ b/pyself/__init__.py @@ -4,6 +4,16 @@ A python package for interfacing with the Spectral Element Library in Fortran (https://github.com/fluidnumerics/SELF). """ -__version__ = "0.1.0" +from ._version import version + +__version__ = version +__title__ = "pyself" __author__ = "Dr. Joe Schoonover" __credits__ = "Fluid Numerics LLC" + + +from pyself.config import * +from pyself.geometry import * +from pyself.interface import * +from pyself.lagrange import * +from pyself.model import * diff --git a/pyself/_utils/__init__.py b/pyself/_utils/__init__.py new file mode 100644 index 000000000..9a324e52e --- /dev/null +++ b/pyself/_utils/__init__.py @@ -0,0 +1 @@ +from .library import * diff --git a/pyself/_utils/library.py b/pyself/_utils/library.py new file mode 100644 index 000000000..bbd85d67f --- /dev/null +++ b/pyself/_utils/library.py @@ -0,0 +1,39 @@ +import ctypes.util +import os + + +def find_library_full_path(library_name): + """ + Finds the full path of a library using ctypes.util.find_library. + + Args: + library_name: The name of the library to find. + + Returns: + The full path of the library, or None if not found. + """ + library_path = ctypes.util.find_library(library_name) + print(f"Library path for {library_name}: {library_path}") + if library_path: + if os.path.isabs(library_path): + return library_path + else: + # On Linux, find_library often returns just the filename, so we search in common library paths + for path in ["/lib", "/usr/lib", "/usr/local/lib"]: + full_path = os.path.join(path, library_path) + if os.path.exists(full_path): + return full_path + # If not found in standard paths, try searching in the directories in LD_LIBRARY_PATH + ld_library_path = os.environ.get("LD_LIBRARY_PATH") + print(f"LD_LIBRARY_PATH: {ld_library_path}") + if ld_library_path: + for path in ld_library_path.split(":"): + full_path = os.path.join(path, library_path) + print( + f"Checking {full_path} for library {library_name} : {os.path.exists(full_path)}" + ) + if os.path.exists(full_path): + return full_path + # If still not found, return None + return None + return None diff --git a/pyself/_version.py b/pyself/_version.py new file mode 100644 index 000000000..3e6bb5b54 --- /dev/null +++ b/pyself/_version.py @@ -0,0 +1 @@ +version = "v0.1.0" diff --git a/pyself/config.py b/pyself/config.py new file mode 100644 index 000000000..29249c69d --- /dev/null +++ b/pyself/config.py @@ -0,0 +1,101 @@ +import json +from typing import Optional, Dict, Any +import os +from ._version import version + + +class SelfModelConfig: + def __init__( + self, config_file: Optional[str] = None, case_directory: Optional[str] = None + ): + """Initialize the SELF model configuration from a JSON file or defaults.""" + self.config = self.default_config() + + self.config_file = config_file + + if config_file: + self.load_config(config_file) + + if case_directory: + self.case_directory = case_directory + os.makedirs(self.case_directory, exist_ok=True) + else: + self.case_directory = os.getcwd() + + @staticmethod + def default_config() -> Dict[str, Any]: + """Return default configuration based on the JSON schema.""" + return { + "version": version, + "model_name": "linear-shallow-water-2d", + "geometry": { + "mesh_file": "", + "uniform_boundary_condition": "no_normal_flow", + "control_degree": 7, + "control_quadrature": "gauss", + "target_degree": 10, + "target_quadrature": "uniform", + "nX": 5, + "nY": 5, + "nZ": 5, + "nTx": 1, + "nTy": 1, + "nTz": 1, + "dx": 0.02, + "dy": 0.02, + "dz": 0.02, + }, + "time_options": { + "integrator": "euler", + "dt": 0.001, + "cfl_max": 0.5, + "start_time": 0.0, + "duration": 1.0, + "io_interval": 0.1, + "update_interval": 50, + }, + "units": {"time": "s", "length": "m", "mass": "kg"}, + "linear-shallow-water-2d": { + "g": 1.0, + "H": 1.0, + "Cd": 0.01, + "f0": 0.0, + "beta": 0.0, + "initial_conditions": { + "geostrophic_balance": False, + "file": "", + "u": 0.0, + "v": 0.0, + "eta": 0.0, + }, + "boundary_conditions": { + "time_dependent": False, + "dt": 0.0, + "from_initial_conditions": False, + "u": 0.0, + "v": 0.0, + "eta": 0.0, + }, + }, + } + + def load_config(self, file_path: str): + """Load configuration from a JSON file""" + with open(file_path, "r") as f: + self.config.update(json.load(f)) + + def save_config(self): + """Save configuration to a JSON file in the self.case_directory.""" + with open(f"{self.case_directory}/model_input.json", "w") as f: + json.dump(self.config, f, indent=4) + + def set_parameter(self, section: str, key: str, value: Any): + """Set a specific parameter within the configuration.""" + if section in self.config and key in self.config[section]: + self.config[section][key] = value + else: + raise KeyError(f"Invalid section '{section}' or key '{key}'.") + + def get_parameter(self, section: str, key: str) -> Any: + """Retrieve a specific parameter value.""" + return self.config.get(section, {}).get(key, None) diff --git a/pyself/geometry.py b/pyself/geometry.py index d00be626b..5f4197124 100644 --- a/pyself/geometry.py +++ b/pyself/geometry.py @@ -2,7 +2,7 @@ # import pyself.lagrange as lagrange - +import numpy as np # class semline: # def __init__(self): @@ -27,7 +27,7 @@ # if 'controlgrid' in list(f.keys()): -# d = f['controlgrid/geometry/x/interior'] +# d = f['controlgrid/geometry/x/interior'] # self.nElem = d.shape[0] # nvar = d.shape[1] # N = d.shape[2] @@ -36,9 +36,9 @@ # else: # print(f"Error: /controlgrid group not found in {hdf5File}.") # return 1 - + # if 'targetgrid' in list(f.keys()): -# d = f['targetgrid/geometry/x/interior'] +# d = f['targetgrid/geometry/x/interior'] # self.nElem = d.shape[0] # nvar = d.shape[1] # N = d.shape[2] @@ -54,13 +54,27 @@ class semquad: def __init__(self): self.interp = lagrange.interp() - self.nElem = 0 # Number of elements - self.x = None # physical x-coordinates at quadrature points - self.y = None # physical y-coordinates at quadrature points - # self.dxds = None # Covariant basis vectors at quadrature points - # self.dsdx = None # Contravariant basis vectors at quadrature points - # self.J = None # Jacobian at quadrature points - self.daskChunkSize=1000 # number of elements per dask chunk + self.nElem = 0 # Number of elements + self.x = None # physical x-coordinates at quadrature points + self.x_name = "x" + self.x_units = None + self.y = None # physical y-coordinates at quadrature points + self.y_name = "y" + self.y_units = None + + self.daskChunkSize = 1000 # number of elements per dask chunk + + def set_coordinates(self, x: np.array, y: np.array): + self.x = da.from_array(x, chunks=(self.daskChunkSize, N, N)) + self.y = da.from_array(y, chunks=(self.daskChunkSize, N, N)) + self.nElem = x.shape[0] + + def set_units(self, units): + self.x_units = units + self.y_units = units + + def set_interpolant(self, interp: lagrange.interp): + self.interp = interp def load(self, hdf5File): """Loads in interpolant and geometry data from SELF model output""" @@ -69,20 +83,19 @@ def load(self, hdf5File): self.interp.load(hdf5File) - f = h5py.File(hdf5File, 'r') - if 'controlgrid' in list(f.keys()): + f = h5py.File(hdf5File, "r") + if "controlgrid" in list(f.keys()): - d = f['controlgrid/geometry/x_dim1'] + d = f["controlgrid/geometry/x_dim1"] self.nElem = d.shape[0] N = d.shape[2] - self.x = da.from_array(d, chunks=(self.daskChunkSize,N,N)) - d = f['controlgrid/geometry/x_dim2'] - self.y = da.from_array(d, chunks=(self.daskChunkSize,N,N)) + self.x = da.from_array(d, chunks=(self.daskChunkSize, N, N)) + d = f["controlgrid/geometry/x_dim2"] + self.y = da.from_array(d, chunks=(self.daskChunkSize, N, N)) self.x_name = "x" - self.x_units = f['controlgrid/geometry/metadata/units/1'] + self.x_units = f["controlgrid/geometry/metadata/units/1"] self.y_name = "y" - self.y_units = f['controlgrid/geometry/metadata/units/1'] - + self.y_units = f["controlgrid/geometry/metadata/units/1"] else: print(f"Error: /controlgrid group not found in {hdf5File}.") @@ -95,14 +108,32 @@ class semhex: def __init__(self): self.interp = lagrange.interp() - self.nElem = 0 # Number of elements - self.x = None # physical x-coordinates at quadrature points - self.y = None # physical y-coordinates at quadrature points - self.z = None # physical z-coordinates at quadrature points - # self.dxds = None # Covariant basis vectors at quadrature points - # self.dsdx = None # Contravariant basis vectors at quadrature points - # self.J = None # Jacobian at quadrature points - self.daskChunkSize=1000 # number of elements per dask chunk + self.nElem = 0 # Number of elements + self.x = None # physical x-coordinates at quadrature points + self.x_name = "x" + self.x_units = None + self.y = None # physical y-coordinates at quadrature points + self.y_name = "y" + self.y_units = None + self.z = None # physical z-coordinates at quadrature points + self.z_name = "z" + self.z_units = None + + self.daskChunkSize = 1000 # number of elements per dask chunk + + def set_coordinates(self, x, y, z): + self.x = x + self.y = y + self.z = z + self.nElem = x.shape[0] + + def set_units(self, units): + self.x_units = units + self.y_units = units + self.z_units = units + + def set_interpolant(self, interp: lagrange.interp): + self.interp = interp def load(self, hdf5File): """Loads in interpolant and geometry data from SELF model output""" @@ -111,27 +142,26 @@ def load(self, hdf5File): self.interp.load(hdf5File) - f = h5py.File(hdf5File, 'r') - if 'controlgrid' in list(f.keys()): + f = h5py.File(hdf5File, "r") + if "controlgrid" in list(f.keys()): - d = f['controlgrid/geometry/x_dim1'] + d = f["controlgrid/geometry/x_dim1"] self.nElem = d.shape[0] N = d.shape[2] - self.x = da.from_array(d, chunks=(self.daskChunkSize,N,N,N)) - d = f['controlgrid/geometry/x_dim2'] - self.y = da.from_array(d, chunks=(self.daskChunkSize,N,N,N)) - d = f['controlgrid/geometry/x_dim3'] - self.z = da.from_array(d, chunks=(self.daskChunkSize,N,N,N)) + self.x = da.from_array(d, chunks=(self.daskChunkSize, N, N, N)) + d = f["controlgrid/geometry/x_dim2"] + self.y = da.from_array(d, chunks=(self.daskChunkSize, N, N, N)) + d = f["controlgrid/geometry/x_dim3"] + self.z = da.from_array(d, chunks=(self.daskChunkSize, N, N, N)) self.x_name = "x" - self.x_units = f['controlgrid/geometry/metadata/units/1'] + self.x_units = f["controlgrid/geometry/metadata/units/1"] self.y_name = "y" - self.y_units = f['controlgrid/geometry/metadata/units/1'] + self.y_units = f["controlgrid/geometry/metadata/units/1"] self.y_name = "z" - self.y_units = f['controlgrid/geometry/metadata/units/1'] - + self.y_units = f["controlgrid/geometry/metadata/units/1"] else: print(f"Error: /controlgrid group not found in {hdf5File}.") return 1 - return 0 \ No newline at end of file + return 0 diff --git a/pyself/interface.py b/pyself/interface.py new file mode 100644 index 000000000..7f375a7ef --- /dev/null +++ b/pyself/interface.py @@ -0,0 +1,408 @@ +#!/usr/bin/env python + + +from pyself.config import SelfModelConfig +from pyself.model import model2d, model3d +from pyself.geometry import semquad, semhex +from pyself import lagrange +from pyself._utils.library import find_library_full_path + +## Add ctypes interface to fortran library +from ctypes import ( + CDLL, + c_int, + c_double, + c_char_p, + POINTER, + c_void_p, + create_string_buffer, +) +import numpy as np +from ctypes.util import find_library +import os +from typing import Union, Any + +_VAR_BUFFER_SIZE = 256 + +MODEL_TO_TYPE = { + # "burgers-1d": model1d, + "linear-shallow-water-2d": model2d, + "linear-euler-2d": model2d, + "linear-euler-3d": model3d, + "gfdles-3d": model3d, +} + + +class SelfModel: + def __init__( + self, + modeldata: Union[model2d, model3d] = None, + config: SelfModelConfig = SelfModelConfig(), + case_directory: str = os.getcwd(), + lib: str = None, + ): + self.case_directory = case_directory + self.config = config + self._config_file = f"{self.config.case_directory}/model_input.json" + + self._modeldata = modeldata # Either a model2d or model3d object + + self._last_pickup_file = None + + if lib is None: + _lib = find_library_full_path("self_interface") + if _lib is None: + raise Exception( + "Could not find the libself_interface.so library. Ensure your LD_LIBRARY_PATH includes the path for libself_interface.so" + ) + else: + try: + self._lib = CDLL(_lib) + except: + raise Exception(f"Could not load the library {lib}") + else: + # Library ust be libself_interface.so + if not lib.endswith("libself_interface.so"): + raise Exception("Library must be libself_interface.so") + # Library must exist + if not os.path.exists(lib): + raise Exception(f"Could not find the library {lib}") + try: + self._lib = CDLL(lib) + except: + raise Exception(f"Could not load the library {lib}") + + self._configure_interface() + self._precision = self._lib.GetPrecision() + self._dtype = {4: np.float32, 8: np.float64}[self._precision] + self._cprec = {4: c_float, 8: c_double}[self._precision] + + self._initialized = False + + def _configure_interface(self): + """Private method to configure the interface to the Fortran library""" + + self._lib.Initialize.argtypes = [c_char_p] + self._lib.Initialize.restype = c_int + + self._lib.UpdateParameters.argtypes = [] + self._lib.UpdateParameters.restype = None + + self._lib.ForwardStep.argtypes = [c_double, c_double] # No arguments + self._lib.ForwardStep.restype = c_int # Function returns an integer + + self._lib.WritePickupFile.argtypes = [c_char_p, c_char_p] + self._lib.WritePickupFile.restype = None + + self._lib.GetSolution.argtypes = [ + POINTER(c_void_p), + POINTER(c_int * 5), + POINTER(c_int), + ] + self._lib.GetSolution.restype = None # Subroutine, no return + + self._lib.SetSolution.argtypes = [ + POINTER(c_void_p), + POINTER(c_int * 5), + ] + self._lib.SetSolution.restype = None # Subroutine, no return + + self._lib.GetVariableName.argtypes = [c_int, c_char_p] + self._lib.GetVariableName.restype = None + + self._lib.GetVariableUnits.argtypes = [c_int, c_char_p] + self._lib.GetVariableUnits.restype = None + + self._lib.GetPrecision.argtypes = [] # No arguments + self._lib.GetPrecision.restype = c_int # Function returns an integer + + self.lib.Finalize.argtypes = [] + self.lib.Finalize.restype = None + + def report_config(self): + """Print the configuration to the console.""" + print("=" * 40) + print(" Model Configuration ".center(40, "=")) + print("=" * 40) + + print("\n[Model]") + model_name = self.config.config["model_name"] + print(f" SELF Configuration Version : {self.config.config['version']}") + print(f" Model Name : {model_name}") + print(f" Case Directory : {self.config.case_directory}") + print(f" Config File : {self._config_file}") + print(f" Precision : {self._precision}") + print(f" Initialized : {self._initialized}") + + print("\n[Geometry]") + for key, value in self.config.config["time_options"].items(): + print(f" {key.replace('_', ' ').capitalize()} : {value}") + + print("\n[Time Options]") + for key, value in self.config.config["time_options"].items(): + print(f" {key.replace('_', ' ').capitalize()} : {value}") + + print("\n[{model_name}]") + for key, value in self.config.config[model_name].items(): + print(json.dumps(value, indent=4)) + + def set_parameter(self, section: str, key: str, value: Any): + """Set a specific parameter within the model configuration.""" + self.config.set_parameter(section, key, value) + + def get_parameter(self, section: str, key: str, value: Any): + """Retrieve a specific parameter from the model configuration.""" + return self.config.get_parameter(section, key) + + def update_parameters(self): + """Push the configuration to the model by writing the configuration + to file and calling the Fortran-side UpdateParameters function.""" + + self.config.save_config() + if self._initialized: + self._lib.UpdateParameters() + else: + raise Exception( + "Configuration file saved, but not pushed to model. Model is not initialized" + ) + + def set_time_integrator(self, integrator: str): + """Set the time integrator in the configuration file. The + selfModel.config attribut is updated and saved to the case directory + json file. + + Parameters: + ----------- + integrator (str): the time integrator to use. Must be one of + 'euler', 'rk2', 'rk3', or 'rk4' + """ + + self.config.set_parameter("time_options", "integrator", integrator) + self.config.save_config() + + def initialize_model(self): + """Initialize the model by calling the Fortran Initialize function. + On the Fortran side this allocates memory and sets up the appropriate + data structures for the model, based on the configuration file. + On exit, the self._initialized flag is set to True.""" + + if not self._initialized: + # Save the config to the case directory + self.config.save_config() + # Call the initialize model function + error = self._lib.Initialize(self._config_file.encode("utf-8")) + if error != 0: + raise Exception( + f"Model returned error code {error} for model_name = {self.config.config['model_name']}" + ) + + # Initialize the _modeldata object + self._modeldata = MODEL_TO_TYPE[self.config.config["model_name"]]() + x, y = self.get_coordinates() + self._modeldata.set_coordinates(x, y) + + self._initialized = True + else: + raise Exception("Model is already initialized") + + def finalize_model(self): + """Finalize the model by calling the Fortran Finalize function. + On the Fortran side this deallocates memory and cleans up the model. + On exit, the self._initialized flag is set to False.""" + + if self._initialized: + self._lib.Finalize() + self._initialized = False + else: + raise Exception("Model is not initialized") + + def forward_step(self, dt, update_interval): + """Advance the model forward in time by calling the Fortran ForwardStep function. + The function takes two arguments: the time step dt and the number of time steps to take. + The function returns an error code, which is 0 if the function executed successfully. + The time integrator is controlled by the configuration file in the + time_options.integrator setting""" + + if not self._initialized: + self.initialize_model() + + if self._precision == 4: + err = self._lib.ForwardStep(c_float(dt), c_float(update_interval)) + else: + err = self._lib.ForwardStep(c_double(dt), c_double(update_interval)) + + return err + + def write_pickup_file(self): + """Write the pickup file by calling the Fortran WritePickupFile function. + The function takes a case directory as an argument and returns the name of the pickup file. + The pickup file is written to the case directory and follows the format "solution.X.h5", where + "X" is a 13-digit zero padded integer that corresponds to the iterate number in the simulation. + + Returns: + -------- + pickup_file (str): the name of the pickup file that was written to disk. + + """ + if not self._initialized: + raise Exception("Model is not initialized") + + # Prepare input and output buffers + case_directory = self.config.case_directory.encode( + "utf-8" + ) # Convert string to bytes (null-terminated) + pickup_file_buffer = create_string_buffer(buffer_size) # Preallocated buffer + + # Call the Fortran subroutine + self._lib.WritePickupFile(case_directory, pickup_file_buffer) + + pickup_file = pickup_file_buffer.value.decode("utf-8").strip() + self._last_pickup_file = pickup_file + + # Convert to Python string (remove null terminator and spaces) + return pickup_file + + def get_solution(self): + """ + Obtains the solution data from the Fortran model and stores it in the _modeldata attribute. + The solution data is returned as a model2d or model3d object, depending on the model configuration. + + Returns: + -------- + modeldata (model2d or model3d): the model data object containing the solution + + """ + if not self._initialized: + raise Exception("Model is not initialized") + + # Get the solution + solution_ptr = c_void_p() + shape = (c_int * 5)() + rank = c_int() + precision = c_int() + self._lib.GetSolution(byref(solution_ptr), shape, byref(rank)) + + # Extract shape values + dim = [shape[i] for i in range(rank.value)] # Extract only relevant dimensions + + # Convert void pointer to float or double pointer + data_ptr = ctypes.cast(solution_ptr, POINTER(self._cprec)) + + # Convert to NumPy array (handling column-major storage) + solution = np.ctypeslib.as_array( + data_ptr, shape=tuple(reversed(dim)) + ) # Reverse shape for row-major order + + # Store the results in the _modeldata object + names = [self._get_variable_name(i) for i in range(dim[0])] + units = [self._get_variable_units(i) for i in range(dim[0])] + self._modeldata.set_solution(solution, names, units) + + return self._modeldata + + def _validate_solution_data(self, data: np.ndarray): + """ + Validate the solution data against the expected shape and type. + The function checks if the data is a NumPy array and if its shape matches + the expected dimensions for the model. + + Parameters: + ---------- + data (np.ndarray): the solution data to validate + + Raises: + ------- + ValueError: if the data is not a NumPy array or if its shape does not match the expected dimensions + + """ + if not self._initialized: + raise Exception("Model is not initialized") + + if not isinstance(data, np.ndarray): + raise ValueError("Solution data must be a NumPy array") + + # Check the shape of the data + expected_shape = self._modeldata.shape() + if data.shape != expected_shape: + raise ValueError( + f"Solution data shape {data.shape} does not match expected shape {expected_shape}" + ) + + def set_solution(self, data: np.ndarray): + """ + Sets the _modeldata attribute with the provided solution data and pushes the + data to the Fortran model. The function validates the data shape and type + before setting it in the model. The data is expected to be a NumPy array + with the same shape as the model's expected solution shape. + + Parameters: + ---------- + data (np.ndarray): the solution data to set in the model + + """ + if not self._initialized: + raise Exception("Model is not initialized") + + self._validate_solution_data(data) + + # Set the solution data in the _modeldata object + self._modeldata.set_solution(data) + + # Get a void pointer to the data + data_ptr = np.asfortranarray(data, dtype=self._dtype).ctypes.data_as(c_void_p) + # Shape handling: up to 5D, pad with 1s if needed + shape = list(np_array.shape) + shape_5d = shape + [1] * (5 - ndim) # Pad to 5 elements + shape_array = (c_int * 5)(*shape_5d) + self_lib.SetSolution(data_ptr, shape_array) + + return self._modeldata + + def get_coordinates(self): + """ + Obtains the coordinates data from the Fortran model and stores it in the _modeldata attribute. + The coordinates data is returned as a semquad or semhex object, depending on the model configuration. + + Returns: + -------- + x (np.ndarray): x-coordinates of the mesh + y (np.ndarray): y-coordinates of the mesh + + """ + if not self._initialized: + raise Exception("Model is not initialized") + + # Get the coordinates + x_ptr = c_void_p() + shape = (c_int * 5)() + rank = c_int() + precision = c_int() + self._lib.GetGeometryCoordinates(byref(x_ptr), shape, byref(rank)) + + # Extract shape values + dim = [shape[i] for i in range(rank.value)] + + # Convert void pointer to float or double pointer + if self._precision == 4: + data_ptr = ctypes.cast(x_ptr, POINTER(c_float)) + else: + data_ptr = ctypes.cast(x_ptr, POINTER(c_double)) + + # Convert to NumPy array (handling column-major storage) + xy = np.ctypeslib.as_array( + data_ptr, shape=tuple(reversed(dim)) + ) # Reverse shape for row-major order + + return xy[0, ...].flatten(), xy[1, ...].flatten() + + def _get_variable_name(self, ivar): + variable_name_buffer = create_string_buffer(_VAR_BUFFER_SIZE) + self._lib.GetVariableName(c_int(ivar), variable_name_buffer) + + return variable_name_buffer.value.decode("utf-8").strip() + + def _get_variable_units(self, ivar): + variable_units_buffer = create_string_buffer(_VAR_BUFFER_SIZE) + self._lib.GetVariableUnits(c_int(ivar), variable_units_buffer) + + return variable_units_buffer.value.decode("utf-8").strip() diff --git a/pyself/model.py b/pyself/model.py new file mode 100644 index 000000000..58010d075 --- /dev/null +++ b/pyself/model.py @@ -0,0 +1,484 @@ +#!/usr/bin/env python +# + + +# Other SELF modules +import numpy as np +import pyself.geometry as geometry +from typing import Optional + + +class model2d: + def __init__(self): + self.solution = None + self.pvdata = None # Pyvista data + self.varnames = None + self.varunits = None + self.geom = geometry.semquad() + + def set_coordinates(self, x: np.array, y: np.array): + self.geom.set_coordinates(x, y) + + @property + def shape(self): + """Returns the shape of the solution array with the number of variables""" + nvar = len(self.solution) + return (nvar) + self.solution[0].data.shape() + + def set_solution( + self, + solution: np.ndarray, + varnames: Optional[list[str]] = None, + varunits: Optional[list[str]] = None, + ): + + if len(shape(solution)) != 4: + print("Error: Solution array must have shape (nvar, nel, N+1, N+1)") + return 1 + else: + if len(varnames) != solution.shape[0]: + print("Error: Number of variable names must match solution array") + return 1 + + if varnames is not None: + self.set_varnames(varnames) + + if varunits is not None: + self.set_varunits(varunits) + + if self.solution is None: + self.solution = [] + # Loop over variable names with index + for i, name in enumerate(varnames): + if varunits is not None: + units = varunits[i] + else: + units = "" + + if varnames is not None: + name = varnames[i] + else: + name = f"solution_{i}" + data = da.from_array( + solution[i, :, :, :].flatten(), + chunks=(self.geom.daskChunkSize, N, N), + ) + self.solution.append( + { + "name": name, + "units": units, + "data": solution[i, :, :, :].flatten(), + } + ) + else: + for i in range(len(self.solution)): + self.solution[i]["data"] = da.from_array( + solution[i, :, :, :].flatten(), + chunks=(self.geom.daskChunkSize, N, N), + ) + + def _set_varnames(self, varnames: list[str]): + self.varnames = varnames + + def _set_varunits(self, varunits: list[str]): + self.varunits = varunits + + def set_geom(self, geom: geometry.semquad): + self.geom = geom + + def load(self, hdf5File): + """Loads in 2-D model from SELF model output""" + import h5py + import dask.array as da + + self.geom.load(hdf5File) + + f = h5py.File(hdf5File, "r") + self.varnames = [] + + if "controlgrid" in list(f.keys()): + + controlgrid = f["controlgrid"] + for group_name in controlgrid.keys(): + + if group_name == "geometry": + continue + + group = controlgrid[group_name] + # Create a list to hold data for this group + setattr(self, group_name, []) + group_data = getattr(self, group_name) + print(f"Loading {group_name} group") + + # Load metadata information + if "metadata" in list(group.keys()): + for v in group[f"metadata/name"].keys(): + + name = group[f"metadata/name/{v}"].asstr()[()][0] + try: + units = group[f"metadata/units/{v}"].asstr()[()][0] + except: + units = "error" + + group_data.append({"name": name, "units": units, "data": None}) + else: + print( + f"Error: /controlgrid/{group_name}/metadata group not found in {hdf5File}." + ) + return 1 + + for k in group.keys(): + k_decoded = k.encode("utf-8").decode("utf-8") + if k == "metadata": + continue + else: + print(f"Loading {k_decoded} field") + # Load the actual data + d = group[k] + N = d.shape[2] + + # Find index for this field + i = 0 + for sol in group_data: + if sol["name"] == k_decoded: + break + else: + i += 1 + + group_data[i]["data"] = da.from_array( + d, chunks=(self.geom.daskChunkSize, N, N) + ) + + self.generate_pyvista() + + else: + print(f"Error: /controlgrid group not found in {hdf5File}.") + return 1 + + return 0 + + def generate_pyvista(self): + """Generates pyvista polyData for each solution variable for plotting""" + import numpy as np + import pyvista as pv + + (nelem, nx, ny) = self.solution[0]["data"].shape + n_points = nelem * nx * ny + n_faces = nelem * (nx - 1) * (ny - 1) + + # Need to use the plot mesh to create a flat list of (x,y,z=0) points + # number of points = (M+1)*(M+1)*nelem + # dimension ordering (i,j,iel) + # Get the x-y points in flattened array for building unstructured data + np_points = np.zeros((n_points, 3)) + np_points[:, 0] = self.geom.x.flatten() + np_points[:, 1] = self.geom.y.flatten() + + # Need to construct the faces from here.. + # Number of faces = M*M*nelem + faces = np.zeros((n_faces, 5), dtype=np.int64) + fid = 0 + for iel in range(0, nelem): + for j in range(0, ny - 1): + for i in range(0, nx - 1): + # lower left corner + n0 = i + nx * (j + ny * iel) + # lower right corner + n1 = i + 1 + nx * (j + ny * iel) + + # upper right corner + n2 = i + 1 + nx * (j + 1 + ny * iel) + + # upper left corner + n3 = i + nx * (j + 1 + ny * iel) + + faces[fid, :] = [4, n0, n1, n2, n3] + fid += 1 + + self.pvdata = pv.PolyData(np_points, faces) + + # Load fields into pvdata + k = 0 + for attr in self.__dict__: + if not attr in ["pvdata", "varnames", "varunits", "geom"]: + controlgroup = getattr(self, attr) + # print(f"Loading {attr} into pvdata") + for var in controlgroup: + # print(f"Loading {var['name']} into pvdata") + self.pvdata.point_data.set_array(var["data"].flatten(), var["name"]) + k += 1 + + print(self.pvdata) + + def update_from_file(self, hdf5File): + """Loads in 2-D model from SELF model output""" + import h5py + import dask.array as da + + f = h5py.File(hdf5File, "r") + + if "controlgrid" in list(f.keys()): + + controlgrid = f["controlgrid"] + for group_name in controlgrid.keys(): + + if group_name == "geometry": + continue + + group = controlgrid[group_name] + # Create a list to hold data for this group + group_data = getattr(self, group_name) + print(f"Loading {group_name} group") + + for k in group.keys(): + k_decoded = k.encode("utf-8").decode("utf-8") + if k == "metadata": + continue + else: + print(f"Loading {k_decoded} field") + # Load the actual data + d = group[k] + N = d.shape[2] + + # Find index for this field + i = 0 + for sol in group_data: + if sol["name"] == k_decoded: + break + else: + i += 1 + + group_data[i]["data"] = da.from_array( + d, chunks=(self.geom.daskChunkSize, N, N) + ) + + # # Load fields into pvdata + k = 0 + for attr in self.__dict__: + if not attr in ["pvdata", "varnames", "varunits", "geom"]: + controlgroup = getattr(self, attr) + for var in controlgroup: + self.pvdata.point_data.set_array( + var["data"].flatten(), var["name"] + ) + k += 1 + + else: + print(f"Error: /controlgrid group not found in {hdf5File}.") + return 1 + + return 0 + + +class model3d: + def __init__(self): + self.solution = None + self.pvdata = None # Pyvista data + self.varnames = None + self.varunits = None + self.geom = geometry.semhex() + + def load(self, hdf5File): + """Loads in 3-D model from SELF model output""" + import h5py + import dask.array as da + + self.geom.load(hdf5File) + + f = h5py.File(hdf5File, "r") + self.varnames = [] + + if "controlgrid" in list(f.keys()): + + controlgrid = f["controlgrid"] + for group_name in controlgrid.keys(): + + if group_name == "geometry": + continue + + group = controlgrid[group_name] + # Create a list to hold data for this group + setattr(self, group_name, []) + group_data = getattr(self, group_name) + print(f"Loading {group_name} group") + + # Load metadata information + if "metadata" in list(group.keys()): + for v in group[f"metadata/name"].keys(): + + name = group[f"metadata/name/{v}"].asstr()[()][0] + try: + units = group[f"metadata/units/{v}"].asstr()[()][0] + except: + units = "error" + + group_data.append({"name": name, "units": units, "data": None}) + else: + print( + f"Error: /controlgrid/{group_name}/metadata group not found in {hdf5File}." + ) + return 1 + + for k in group.keys(): + k_decoded = k.encode("utf-8").decode("utf-8") + if k == "metadata": + continue + else: + print(f"Loading {k_decoded} field") + # Load the actual data + d = group[k] + N = d.shape[2] + + # Find index for this field + i = 0 + for sol in group_data: + if sol["name"] == k_decoded: + break + else: + i += 1 + + group_data[i]["data"] = da.from_array( + d, chunks=(self.geom.daskChunkSize, N, N, N) + ) + + self.generate_pyvista() + + else: + print(f"Error: /controlgrid group not found in {hdf5File}.") + return 1 + + return 0 + + def generate_pyvista(self): + """Generates pyvista polyData for each solution variable for plotting""" + import numpy as np + import pyvista as pv + + (nelem, nx, ny, nz) = self.solution[0]["data"].shape + n_points = nelem * nx * ny * nz + n_cells = nelem * (nx - 1) * (ny - 1) * (nz - 1) + + # Need to use the plot mesh to create a flat list of (x,y,z=0) points + # number of points = (M+1)*(M+1)*nelem + # dimension ordering (i,j,iel) + # Get the x-y points in flattened array for building unstructured data + points = np.zeros((n_points, 3)) + points[:, 0] = self.geom.x.flatten() + points[:, 1] = self.geom.y.flatten() + points[:, 2] = self.geom.z.flatten() + + print(f"---------------------") + print(f"Converting to pyvista") + print(f"---------------------") + print(f" n points : {n_points}") + print(f" n cells : {n_cells}") + + cells = np.zeros((n_cells * 9), dtype=pv.ID_TYPE) + celltypes = np.zeros((n_cells), dtype=pv.ID_TYPE) + + eid = 0 + nid = 0 + for iel in range(0, nelem): + for k in range(0, nz - 1): + for j in range(0, ny - 1): + for i in range(0, nx - 1): + cells[nid] = 8 + nid += 1 + cells[nid] = _node_index_3d(i + 1, j + 1, k, nx, ny, nz, iel) + nid += 1 + cells[nid] = _node_index_3d(i, j + 1, k, nx, ny, nz, iel) + nid += 1 + cells[nid] = _node_index_3d(i, j, k, nx, ny, nz, iel) + nid += 1 + cells[nid] = _node_index_3d(i + 1, j, k, nx, ny, nz, iel) + nid += 1 + cells[nid] = _node_index_3d( + i + 1, j + 1, k + 1, nx, ny, nz, iel + ) + nid += 1 + cells[nid] = _node_index_3d(i, j + 1, k + 1, nx, ny, nz, iel) + nid += 1 + cells[nid] = _node_index_3d(i, j, k + 1, nx, ny, nz, iel) + nid += 1 + cells[nid] = _node_index_3d(i + 1, j, k + 1, nx, ny, nz, iel) + nid += 1 + celltypes[eid] = pv.CellType.HEXAHEDRON + eid += 1 + + self.pvdata = pv.UnstructuredGrid(cells, celltypes, points) + + # # Load fields into pvdata + k = 0 + for attr in self.__dict__: + if not attr in ["pvdata", "varnames", "varunits", "geom"]: + controlgroup = getattr(self, attr) + # print(f"Loading {attr} into pvdata") + for var in controlgroup: + # print(f"Loading {var['name']} into pvdata") + self.pvdata.point_data.set_array(var["data"].flatten(), var["name"]) + k += 1 + + print(self.pvdata) + + def update_from_file(self, hdf5File): + """Loads in 3-D model from SELF model output""" + import h5py + import dask.array as da + + f = h5py.File(hdf5File, "r") + + if "controlgrid" in list(f.keys()): + + controlgrid = f["controlgrid"] + for group_name in controlgrid.keys(): + + if group_name == "geometry": + continue + + group = controlgrid[group_name] + # Create a list to hold data for this group + group_data = getattr(self, group_name) + print(f"Loading {group_name} group") + + for k in group.keys(): + k_decoded = k.encode("utf-8").decode("utf-8") + if k == "metadata": + continue + else: + print(f"Loading {k_decoded} field") + # Load the actual data + d = group[k] + N = d.shape[2] + + # Find index for this field + i = 0 + for sol in group_data: + if sol["name"] == k_decoded: + break + else: + i += 1 + + group_data[i]["data"] = da.from_array( + d, chunks=(self.geom.daskChunkSize, N, N, N) + ) + + # # Load fields into pvdata + k = 0 + for attr in self.__dict__: + if not attr in ["pvdata", "varnames", "varunits", "geom"]: + controlgroup = getattr(self, attr) + for var in controlgroup: + self.pvdata.point_data.set_array( + var["data"].flatten(), var["name"] + ) + k += 1 + + else: + print(f"Error: /controlgrid group not found in {hdf5File}.") + return 1 + + return 0 + + +def _node_index_3d(i, j, k, nx, ny, nz, iel): + return i + nx * (j + ny * (k + nz * iel)) diff --git a/pyself/model2d.py b/pyself/model2d.py deleted file mode 100644 index 03186ed89..000000000 --- a/pyself/model2d.py +++ /dev/null @@ -1,193 +0,0 @@ -#!/usr/bin/env python -# - - -# Other SELF modules -import pyself.geometry as geometry - -class model: - def __init__(self): - self.solution = None - self.pvdata = None # Pyvista data - self.varnames = None - self.varunits = None - self.geom = geometry.semquad() - - def load(self, hdf5File): - """Loads in 2-D model from SELF model output""" - import h5py - import dask.array as da - - self.geom.load(hdf5File) - - f = h5py.File(hdf5File, 'r') - self.varnames = [] - - if 'controlgrid' in list(f.keys()): - - controlgrid = f['controlgrid'] - for group_name in controlgrid.keys(): - - if( group_name == 'geometry' ): - continue - - group = controlgrid[group_name] - # Create a list to hold data for this group - setattr(self, group_name, []) - group_data = getattr(self, group_name) - print(f"Loading {group_name} group") - - # Load metadata information - if( 'metadata' in list(group.keys()) ): - for v in group[f"metadata/name"].keys(): - - name = group[f"metadata/name/{v}"].asstr()[()][0] - try: - units = group[f"metadata/units/{v}"].asstr()[()][0] - except: - units = "error" - - group_data.append({ - "name": name, - "units": units, - 'data': None - }) - else: - print(f"Error: /controlgrid/{group_name}/metadata group not found in {hdf5File}.") - return 1 - - for k in group.keys(): - k_decoded = k.encode('utf-8').decode('utf-8') - if k == 'metadata': - continue - else: - print(f"Loading {k_decoded} field") - # Load the actual data - d = group[k] - N = d.shape[2] - - # Find index for this field - i = 0 - for sol in group_data: - if sol['name'] == k_decoded: - break - else: - i += 1 - - group_data[i]['data'] = da.from_array(d, chunks=(self.geom.daskChunkSize, N, N)) - - self.generate_pyvista() - - else: - print(f"Error: /controlgrid group not found in {hdf5File}.") - return 1 - - return 0 - - def generate_pyvista(self): - """Generates pyvista polyData for each solution variable for plotting""" - import numpy as np - import pyvista as pv - - (nelem, nx, ny) = self.solution[0]['data'].shape - n_points = nelem*nx*ny - n_faces = nelem*(nx-1)*(ny-1) - - # Need to use the plot mesh to create a flat list of (x,y,z=0) points - # number of points = (M+1)*(M+1)*nelem - # dimension ordering (i,j,iel) - # Get the x-y points in flattened array for building unstructured data - np_points = np.zeros((n_points,3)) - np_points[:,0] = self.geom.x.flatten() - np_points[:,1] = self.geom.y.flatten() - - # Need to construct the faces from here.. - # Number of faces = M*M*nelem - faces = np.zeros((n_faces,5),dtype=np.int64) - fid = 0 - for iel in range(0,nelem): - for j in range(0,ny-1): - for i in range(0,nx-1): - # lower left corner - n0 = i + nx*( j + ny*iel ) - # lower right corner - n1 = i+1 + nx*( j + ny*iel ) - - # upper right corner - n2 = i+1 + nx*( j+1 + ny*iel ) - - # upper left corner - n3 = i + nx*( j+1 + ny*iel ) - - faces[fid,:] = [4, n0, n1, n2, n3] - fid += 1 - - self.pvdata = pv.PolyData(np_points, faces) - - # Load fields into pvdata - k = 0 - for attr in self.__dict__: - if not attr in ['pvdata','varnames','varunits','geom']: - controlgroup = getattr(self, attr) - #print(f"Loading {attr} into pvdata") - for var in controlgroup: - # print(f"Loading {var['name']} into pvdata") - self.pvdata.point_data.set_array(var['data'].flatten(),var['name']) - k+=1 - - print(self.pvdata) - - def update_from_file(self, hdf5File): - """Loads in 2-D model from SELF model output""" - import h5py - import dask.array as da - - f = h5py.File(hdf5File, 'r') - - if 'controlgrid' in list(f.keys()): - - controlgrid = f['controlgrid'] - for group_name in controlgrid.keys(): - - if( group_name == 'geometry' ): - continue - - group = controlgrid[group_name] - # Create a list to hold data for this group - group_data = getattr(self, group_name) - print(f"Loading {group_name} group") - - for k in group.keys(): - k_decoded = k.encode('utf-8').decode('utf-8') - if k == 'metadata': - continue - else: - print(f"Loading {k_decoded} field") - # Load the actual data - d = group[k] - N = d.shape[2] - - # Find index for this field - i = 0 - for sol in group_data: - if sol['name'] == k_decoded: - break - else: - i += 1 - - group_data[i]['data'] = da.from_array(d, chunks=(self.geom.daskChunkSize, N, N)) - - # # Load fields into pvdata - k = 0 - for attr in self.__dict__: - if not attr in ['pvdata','varnames','varunits','geom']: - controlgroup = getattr(self, attr) - for var in controlgroup: - self.pvdata.point_data.set_array(var['data'].flatten(),var['name']) - k+=1 - - else: - print(f"Error: /controlgrid group not found in {hdf5File}.") - return 1 - - return 0 \ No newline at end of file diff --git a/pyself/model3d.py b/pyself/model3d.py deleted file mode 100644 index a255780eb..000000000 --- a/pyself/model3d.py +++ /dev/null @@ -1,212 +0,0 @@ -#!/usr/bin/env python -# - - -# Other SELF modules -import pyself.geometry as geometry - -def node_index_3d(i,j,k,nx,ny,nz,iel): - return i + nx*( j + ny*( k + nz*iel ) ) - -class model: - def __init__(self): - self.solution = None - self.pvdata = None # Pyvista data - self.varnames = None - self.varunits = None - self.geom = geometry.semhex() - - def load(self, hdf5File): - """Loads in 3-D model from SELF model output""" - import h5py - import dask.array as da - - self.geom.load(hdf5File) - - f = h5py.File(hdf5File, 'r') - self.varnames = [] - - if 'controlgrid' in list(f.keys()): - - controlgrid = f['controlgrid'] - for group_name in controlgrid.keys(): - - if( group_name == 'geometry' ): - continue - - group = controlgrid[group_name] - # Create a list to hold data for this group - setattr(self, group_name, []) - group_data = getattr(self, group_name) - print(f"Loading {group_name} group") - - # Load metadata information - if( 'metadata' in list(group.keys()) ): - for v in group[f"metadata/name"].keys(): - - name = group[f"metadata/name/{v}"].asstr()[()][0] - try: - units = group[f"metadata/units/{v}"].asstr()[()][0] - except: - units = "error" - - group_data.append({ - "name": name, - "units": units, - 'data': None - }) - else: - print(f"Error: /controlgrid/{group_name}/metadata group not found in {hdf5File}.") - return 1 - - for k in group.keys(): - k_decoded = k.encode('utf-8').decode('utf-8') - if k == 'metadata': - continue - else: - print(f"Loading {k_decoded} field") - # Load the actual data - d = group[k] - N = d.shape[2] - - # Find index for this field - i = 0 - for sol in group_data: - if sol['name'] == k_decoded: - break - else: - i += 1 - - group_data[i]['data'] = da.from_array(d, chunks=(self.geom.daskChunkSize, N, N, N)) - - self.generate_pyvista() - - else: - print(f"Error: /controlgrid group not found in {hdf5File}.") - return 1 - - return 0 - - def generate_pyvista(self): - """Generates pyvista polyData for each solution variable for plotting""" - import numpy as np - import pyvista as pv - - (nelem, nx, ny, nz) = self.solution[0]['data'].shape - n_points = nelem*nx*ny*nz - n_cells = nelem*(nx-1)*(ny-1)*(nz-1) - - # Need to use the plot mesh to create a flat list of (x,y,z=0) points - # number of points = (M+1)*(M+1)*nelem - # dimension ordering (i,j,iel) - # Get the x-y points in flattened array for building unstructured data - points = np.zeros((n_points,3)) - points[:,0] = self.geom.x.flatten() - points[:,1] = self.geom.y.flatten() - points[:,2] = self.geom.z.flatten() - - print( f"---------------------") - print( f"Converting to pyvista") - print( f"---------------------") - print( f" n points : {n_points}") - print( f" n cells : {n_cells}") - - cells = np.zeros((n_cells*9),dtype=pv.ID_TYPE) - celltypes = np.zeros((n_cells),dtype=pv.ID_TYPE) - - eid = 0 - nid = 0 - for iel in range(0,nelem): - for k in range(0,nz-1): - for j in range(0,ny-1): - for i in range(0,nx-1): - cells[nid] = 8 - nid+=1 - cells[nid] = node_index_3d(i+1,j+1,k,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i,j+1,k,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i,j,k,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i+1,j,k,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i+1,j+1,k+1,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i,j+1,k+1,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i,j,k+1,nx,ny,nz,iel) - nid+=1 - cells[nid] = node_index_3d(i+1,j,k+1,nx,ny,nz,iel) - nid+=1 - celltypes[eid] = pv.CellType.HEXAHEDRON - eid+=1 - - self.pvdata = pv.UnstructuredGrid(cells, celltypes, points) - - # # Load fields into pvdata - k = 0 - for attr in self.__dict__: - if not attr in ['pvdata','varnames','varunits','geom']: - controlgroup = getattr(self, attr) - #print(f"Loading {attr} into pvdata") - for var in controlgroup: - # print(f"Loading {var['name']} into pvdata") - self.pvdata.point_data.set_array(var['data'].flatten(),var['name']) - k+=1 - - print(self.pvdata) - - def update_from_file(self, hdf5File): - """Loads in 3-D model from SELF model output""" - import h5py - import dask.array as da - - f = h5py.File(hdf5File, 'r') - - if 'controlgrid' in list(f.keys()): - - controlgrid = f['controlgrid'] - for group_name in controlgrid.keys(): - - if( group_name == 'geometry' ): - continue - - group = controlgrid[group_name] - # Create a list to hold data for this group - group_data = getattr(self, group_name) - print(f"Loading {group_name} group") - - for k in group.keys(): - k_decoded = k.encode('utf-8').decode('utf-8') - if k == 'metadata': - continue - else: - print(f"Loading {k_decoded} field") - # Load the actual data - d = group[k] - N = d.shape[2] - - # Find index for this field - i = 0 - for sol in group_data: - if sol['name'] == k_decoded: - break - else: - i += 1 - - group_data[i]['data'] = da.from_array(d, chunks=(self.geom.daskChunkSize, N, N, N)) - - # # Load fields into pvdata - k = 0 - for attr in self.__dict__: - if not attr in ['pvdata','varnames','varunits','geom']: - controlgroup = getattr(self, attr) - for var in controlgroup: - self.pvdata.point_data.set_array(var['data'].flatten(),var['name']) - k+=1 - - else: - print(f"Error: /controlgrid group not found in {hdf5File}.") - return 1 - - return 0 \ No newline at end of file diff --git a/setup.py b/setup.py index 73efe4628..592ede798 100644 --- a/setup.py +++ b/setup.py @@ -1,22 +1,19 @@ -from setuptools import setup +from setuptools import setup, find_packages setup( - name='pyself', - version='0.0.1', - description='A python interface for the Spectral Element Library in Fortran', - url='https://github.com/fluidnumerics/self', - author='Fluid Numerics', - author_email='support@fluidnumerics.com', - license='3-Clause BSD with Attribution', - packages=['pyself'], - install_requires=['h5py>=3.7.0', - 'dask', - 'pyvista', - 'imageio[ffmpeg]'], + name="pyself", + version="0.0.1", + description="A python interface for the Spectral Element Library in Fortran", + url="https://github.com/fluidnumerics/self", + author="Fluid Numerics", + author_email="support@fluidnumerics.com", + license="3-Clause BSD with Attribution", + packages=find_packages(), + install_requires=["h5py>=3.7.0", "dask", "pyvista", "imageio[ffmpeg]"], classifiers=[ - 'Development Status :: 1 - Planning', - 'Intended Audience :: Science/Research', - 'Operating System :: POSIX :: Linux', - 'Programming Language :: Python :: 3' + "Development Status :: 1 - Planning", + "Intended Audience :: Science/Research", + "Operating System :: POSIX :: Linux", + "Programming Language :: Python :: 3", ], ) diff --git a/share/input.json b/share/input.json new file mode 100644 index 000000000..5ee835612 --- /dev/null +++ b/share/input.json @@ -0,0 +1,58 @@ +{ + "version": "v0.0.0", + "model_name": "linear-shallow-water-2d", + "geometry": { + "mesh_file": "mesh/Circle/Circle_mesh.h5", + "control_degree": 7, + "control_quadrature": "gauss", + "target_degree": 16, + "target_quadrature": "uniform", + "uniform_boundary_condition":"no_normal_flow" + }, + "time_options": { + "integrator": "rk3", + "dt": 0.0025, + "cfl_max": 0.0, + "start_time": 0.0, + "duration": 30.0, + "io_interval": 0.05, + "update_interval": 50 + }, + "units": { + "time": "s", + "length": "m", + "mass": "kg" + }, + "linear-shallow-water-2d": { + "environment": { + "g": 1.0, + "H": 1.0, + "Cd": 0.25, + "f0": 10.0, + "beta": 0.0 + }, + "initial_conditions": { + "geostrophic_balance": false, + "static_state": true, + "file": "", + "u": "", + "v": "", + "eta": "" + }, + "boundary_conditions": { + "time_dependent": false, + "dt": 0.0, + "file": "", + "from_initial_conditions": false, + "u": "", + "v": "", + "eta": "" + }, + "impulse_source_term": { + "amplitude": [0.0], + "spatial_width": [0.0], + "xc": [0.0], + "yc": [0.0] + } + } +} \ No newline at end of file diff --git a/share/self.json b/share/self.json new file mode 100644 index 000000000..953fe4eaa --- /dev/null +++ b/share/self.json @@ -0,0 +1,548 @@ +{ + "$schema": "http://json-schema.org/draft-07/schema", + "$id": "blank", + "title": "SELF Model Configuration", + "description": "Schema for conservation law solvers with the Spectral Element Library in Fortran", + "type": "object", + "properties": { + "version": { + "description": "Version of SELF associated with this schema", + "type": "string", + "default": "v0.0.0" + }, + "model_name": { + "description": "Name of the model to run with", + "type": "string", + "enum": [ + "burgers-1d", + "linear-shallow-water-2d", + "linear-euler-2d", + "linear-euler-3d", + "gfdles-3d" + ] + }, + "geometry": { + "description": "Configurations related to the mesh and quadrature", + "type": "object", + "properties": { + "mesh_file": { + "description": "Fully qualified path to a mesh file.", + "type": "string", + "default": "" + }, + "uniform_boundary_condition": { + "description": "If provided, all boundary conditions will be set to this value.", + "type": "string", + "default": "", + "enum": [ + "", + "no_normal_flow", + "radiation", + "prescribed" + ] + }, + "control_degree": { + "description": "Polynomial degree for the control grid quadrature.", + "type": "integer", + "default": 7 + }, + "control_quadrature": { + "description": "The quadrature type for the control points.", + "type": "string", + "enum": [ + "gauss", + "gauss-lobatto", + "chebyshev-gauss", + "chebyshev-gauss-lobatto" + ], + "default": "gauss" + }, + "target_degree": { + "description": "Polynomial degree for the target grid quadrature.", + "type": "integer", + "default": 10 + }, + "target_quadrature": { + "description": "The quadrature type for the target points.", + "type": "string", + "enum": [ + "uniform", + "gauss", + "gauss-lobatto", + "chebyshev-gauss", + "chebyshev-gauss-lobatto" + ], + "default": "uniform" + }, + "nX": { + "description": "Number of points in the x-direction per tile for structured grid generation.", + "type": "integer", + "default": 5 + }, + "nY": { + "description": "Number of points in the y-direction per tile for structured grid generation.", + "type": "integer", + "default": 5 + }, + "nZ": { + "description": "Number of points in the y-direction per tile for structured grid generation.", + "type": "integer", + "default": 5 + }, + "nTx": { + "description": "Number of tiles in the x-direction for structured grid generation.", + "type": "integer", + "default": 1 + }, + "nTy": { + "description": "Number of tiles in the x-direction for structured grid generation.", + "type": "integer", + "default": 1 + }, + "nTz": { + "description": "Number of tiles in the x-direction for structured grid generation.", + "type": "integer", + "default": 1 + }, + "dx": { + "description": "Element width in the x-direction.", + "type": "number", + "default": 0.02 + }, + "dy": { + "description": "Element width in the y-direction.", + "type": "number", + "default": 0.02 + }, + "dz": { + "description": "Element width in the z-direction.", + "type": "number", + "default": 0.02 + + } + }, + "time_options": { + "description": "Configuration for the time integration.", + "type": "object", + "properties": { + "integrator": { + "description": "Type of time integrator to use to forward step the model.", + "type": "string", + "enum": [ + "euler", + "rk2", + "rk3", + "rk4" + ], + "default": "euler" + }, + "dt": { + "type": "number", + "minimum": 0, + "description": "The size of the time step for a time integrator expressed in units.time ." + }, + "cfl_max": { + "type": "number", + "minimum": 0, + "description": "The maximum CFL number for time integration. If non-zero, dt will be calculated using cfl_max and the mesh." + }, + "start_time": { + "description": "The value for the initial time in units.time .", + "type": "number", + "minimum": 0 + }, + "duration": { + "description": "The length of the simulation in units.time .", + "type": "number", + "minimum": 0 + }, + "io_interval": { + "description": "The amount of time between model state ouput in units.time . If set to 0, only the first and last state will be output.", + "type": "number", + "minimum": 0 + }, + "update_interval": { + "description": "The number of time steps between model parameter updates. (For interactivity)", + "type": "number", + "minimum": 50 + } + } + }, + "units": { + "description": "", + "type": "object", + "properties": { + "time": { + "description": "The units for time", + "type": "string", + "enum": [ + "ns", + "ms", + "s", + "Ks", + "Ms", + "Gs" + ], + "default": "s" + }, + "length": { + "description": "The units for length", + "type": "string", + "enum": [ + "nm", + "mm", + "cm", + "m", + "Km" + ], + "default": "m" + }, + "mass": { + "description": "The units for mass", + "type": "string", + "enum": [ + "mg", + "g", + "kg" + ], + "default": "kg" + } + } + }, + "burgers-1d": { + "description": "Parameters for the burgers 1d solver", + "type": "object", + "properties": { + "u0": { + "type": "string", + "description": "Initial condition.", + "default": "u=0" + }, + "uL": { + "type": "string", + "description": "Left boundary condition.", + "default": "u=0" + }, + "uR": { + "type": "string", + "description": "Right boundary condition.", + "default": "u=0" + }, + "uxL": { + "type": "string", + "description": "Left boundary condition for the gradient.", + "default": "u=0" + }, + "uxR": { + "type": "string", + "description": "Right boundary condition for the gradient.", + "default": "u=0" + }, + "viscosity": { + "type": "number", + "description": "Viscosity of the fluid.", + "default": "u=0" + } + } + }, + "gfdles-3d": { + "description": "Parameters for the compressible navier-stokes (2d) solver", + "type": "object", + "properties": { + "sgs_closure": { + "description": "Parameters for sub-grid scale closure", + "type": "object", + "properties": { + "model": { + "description": "The SGS model to use for closure", + "type": "string", + "enum": [ + "none", + "constant_del2" + ], + "default": "constant_del2" + }, + "gradient_variables": { + "description": "The type of variables to use for gradient calculations for SGS fluxes", + "type": "string", + "enum": [ + "conservative", + "primitive", + "entropy" + ], + "default": "primitive" + } + } + }, + "split_form": { + "description": "The formulation of the hyperbolic fluxes to use", + "type": "string", + "enum": [ + "conservative" + ], + "default": "conservative" + }, + "environment": { + "description": "Settings for environmental parameters", + "type": "object", + "properties": { + "potential": { + "description": "An equation that describes the potential force. The gradient of this field is the potential force in the momentum equations", + "type": "string", + "default": "" + } + } + }, + "fluid": { + "description": "Settings for fluid parameters", + "type": "object", + "properties": { + "Cp": { + "description": "Heat capacity at constant pressure", + "type": "number", + "default": 1.005 + }, + "Cv": { + "description": "Heat capacity at constant volume", + "type": "number", + "default": 0.718 + }, + "R": { + "description": "Ideal gas constant", + "type": "number", + "default": 287 + }, + "rho": { + "description": "Default density", + "type": "number", + "default": 1.2754 + }, + "T": { + "description": "Default temperature", + "type": "number", + "default": 273 + }, + "energy": { + "description": "Default internal energy", + "type": "number", + "default": 117526.5 + }, + "equation_of_state": { + "description": "Equation of state", + "type": "string", + "enum": [ + "ideal_gas", + "linear_gibbs_seawater" + ], + "default": "ideal_gas" + }, + "viscosity": { + "description": "The constant value of the dynamic viscosity expressed using units consistent with units attributes", + "type": "number", + "default": 0 + }, + "thermal_diffusivity": { + "description": "The constant value of the thermal diffusivity expressed using units consistent with units attributes", + "type": "number", + "default": 0 + } + } + }, + "initial_conditions": { + "description": "Settings for the fluid initial conditions. Assumes primitive variables are set.", + "type": "object", + "properties": { + "hydrostatic_adjustment": { + "type": "boolean", + "description": "Enable hydrostatic adjustment before starting forward integration.", + "default": false + }, + "static_state": { + "type": "boolean", + "description": "Set the fluid state to the static parameters in fluid attribute at the beginning. If set to true, supplied equations or fields from file are added to the static state.", + "default": false + }, + "file": { + "type": "string", + "description": "File to read initial conditions from. Assumes conservative variables are defined in the file.", + "default": "" + }, + "u": { + "type": "string", + "description": "Equation for the x-velocity component initial condition.", + "default": "u=0" + }, + "v": { + "type": "string", + "description": "Equation for the y-velocity component initial condition.", + "default": "v=0" + }, + "rho": { + "type": "string", + "description": "Equation for the density field initial condition.", + "default": "r=0" + }, + "T": { + "type": "string", + "description": "Equation for the temperature field initial condition.", + "default": "u=0" + } + } + }, + "boundary_conditions": { + "description": "Settings for prescribed fluid boundary conditions. Assumes primitive variables are set.", + "type": "object", + "properties": { + "time_dependent": { + "type": "boolean", + "description": "Enable time dependent boundary conditions.", + "default": false + }, + "dt": { + "type": "number", + "description": "The time interval at which the boundary conditions are re-evaluated. Linear interpolation is done in-between.", + "default": 0 + }, + "from_initial_conditions": { + "type": "boolean", + "description": "Obtain the boundary conditions from the initial conditions.", + "default": false + }, + "u": { + "type": "string", + "description": "Equation for the x-velocity component.", + "default": "u=0" + }, + "v": { + "type": "string", + "description": "Equation for the y-velocity component.", + "default": "v=0" + }, + "rho": { + "type": "string", + "description": "Equation for the density field.", + "default": "r=0" + }, + "T": { + "type": "string", + "description": "Equation for the temperature field.", + "default": "u=0" + } + } + } + } + }, + "linear-shallow-water-2d": { + "description": "Parameters for the linear-shallow-water-2d solver", + "type": "object", + "properties": { + "environment": { + "description": "Settings for environmental parameters", + "type": "object", + "properties": { + "g": { + "description": "Acceleration of gravity", + "type": "number", + "default": 1.0 + }, + "H": { + "description": "Resting fluid depth (constant)", + "type": "number", + "default": 1.0 + }, + "Cd": { + "description": "Linear drag coefficient", + "type": "number", + "default": 0.0 + }, + "f0": { + "description": "Constant coriolis parameter", + "type": "number", + "default": 0.0 + }, + "beta": { + "description": "Rate of change of coriolis parameter with latitude (y)", + "type": "number", + "default": 0.0 + } + + } + }, + "initial_conditions": { + "description": "Settings for the fluid initial conditions.", + "type": "object", + "properties": { + "geostrophic_balance": { + "type": "boolean", + "description": "When the coriolis parameter is non-zero within the model domain, determines if the velocity fields are calculated from the free surface height.", + "default": false + }, + "file": { + "type": "string", + "description": "File to read initial conditions from. Assumes conservative variables are defined in the file.", + "default": "" + }, + "u": { + "type": "string", + "description": "Equation for the x-velocity component initial condition.", + "default": "u=0" + }, + "v": { + "type": "string", + "description": "Equation for the y-velocity component initial condition.", + "default": "v=0" + }, + "eta": { + "type": "string", + "description": "Equation for the free-surface height.", + "default": "r=0" + } + } + }, + "boundary_conditions": { + "description": "Settings for prescribed fluid boundary conditions.", + "type": "object", + "properties": { + "time_dependent": { + "type": "boolean", + "description": "Enable time dependent boundary conditions.", + "default": false + }, + "dt": { + "type": "number", + "description": "The time interval at which the boundary conditions are re-evaluated. Linear interpolation is done in-between.", + "default": 0 + }, + "from_initial_conditions": { + "type": "boolean", + "description": "Obtain the boundary conditions from the initial conditions.", + "default": false + }, + "u": { + "type": "string", + "description": "Equation for the x-velocity component.", + "default": "u=0" + }, + "v": { + "type": "string", + "description": "Equation for the y-velocity component.", + "default": "v=0" + }, + "eta": { + "type": "string", + "description": "Equation for the free surface height field", + "default": "r=0" + } + } + } + } + } + }, + "required": [ + "version", + "model_name", + "geometry", + "time_options", + "units" + ] +} diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 6dc5ca790..ccc1ef059 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -41,6 +41,11 @@ endif() file(GLOB SELF_HEADERS "${CMAKE_CURRENT_SOURCE_DIR}/*.h") +if(JSONFORTRAN_LIBRARIES) + file(GLOB SELF_JSON_FSRC "${CMAKE_CURRENT_SOURCE_DIR}/json/*.f*") + file(APPEND SELF_FSRC "${SELF_JSON_FSRC}") +endif() + # Enable pre-processing for source code set_source_files_properties( ${SELF_FSRC} @@ -52,25 +57,23 @@ set_source_files_properties( PROPERTIES Fortran_PREPROCESS ON ) -set_source_files_properties( - ${SELF_MODEL_FSRC} - PROPERTIES Fortran_PREPROCESS ON -) set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include) add_library(self SHARED ${SELF_FSRC} ${SELF_BACKEND_CPPSRC} ${SELF_BACKEND_FSRC}) -#set_target_properties(self PROPERTIES OUTPUT_NAME "self") + target_link_libraries(self PUBLIC ${FEQPARSE_LIBRARIES} HDF5::HDF5 ${MPI_Fortran_LIBRARIES} - ${BACKEND_LIBRARIES}) + ${BACKEND_LIBRARIES} + ${JSONFORTRAN_LIBRARIES}) target_include_directories(self PUBLIC ${FEQPARSE_INCLUDE_DIRS} ${HDF5_INCLUDE_DIRS} - ${MPI_Fortran_INCLUDE_DIRS}) + ${MPI_Fortran_INCLUDE_DIRS} + ${JSONFORTRAN_INCLUDE_DIRS}) target_compile_options(self PUBLIC -fPIC) diff --git a/src/SELF_BoundaryConditions.f90 b/src/SELF_BoundaryConditions.f90 new file mode 100644 index 000000000..598ebd731 --- /dev/null +++ b/src/SELF_BoundaryConditions.f90 @@ -0,0 +1,239 @@ +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! +! +! Maintainers : support@fluidnumerics.com +! Official Repository : https://github.com/FluidNumerics/self/ +! +! Copyright © 2024 Fluid Numerics LLC +! +! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in +! the documentation and/or other materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from +! this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! + +module SELF_BoundaryConditions + + use SELF_SupportRoutines + use SELF_Metadata + use SELF_Model + + implicit none + integer,parameter :: SELF_BCNAME_LENGTH = 32 + + type BoundaryCondition + procedure(SELF_bcMethod),pointer :: bcMethod => null() ! + integer :: bcid + character(SELF_BCNAME_LENGTH) :: bcname + integer :: nBoundaries ! Number of boundaries this BC applies to + integer,allocatable :: elements(:) ! List of elements this BC applies to + integer,allocatable :: sides(:) ! List of local sides this BC applies to + type(BoundaryCondition),pointer :: next => null() + type(BoundaryCondition),pointer :: prev => null() + endtype BoundaryCondition + + type BoundaryConditionList + type(BoundaryCondition),pointer :: current => null() + type(BoundaryCondition),pointer :: head => null() + type(BoundaryCondition),pointer :: tail => null() + integer :: nbc + + contains + procedure,public :: init => Init_BCList + procedure,public :: free => Free_BCList + procedure,private :: MoveNext + procedure,private :: rewind + procedure,public :: GetBCForID + generic,public :: RegisterBoundaryCondition => RegisterbcMethod + procedure,private :: RegisterbcMethod + + endtype BoundaryConditionList + + interface + subroutine SELF_bcMethod(this,mymodel) + use SELF_Constants,only:prec + use SELF_Model,only:Model + import BoundaryCondition + implicit none + class(BoundaryCondition),intent(in) :: this + class(Model),intent(inout) :: mymodel + endsubroutine SELF_bcMethod + endinterface + +contains + +! //////////////////////////////////////////// ! +! Boundary Condition Methods +! ////////////////////////////////////////////// ! + + subroutine Init_BCList(list) + class(BoundaryConditionList),intent(inout) :: list + list%head => null() + list%tail => null() + list%current => null() + list%nbc = 0 + endsubroutine Init_BCList + + subroutine Free_BCList(list) + class(BoundaryConditionList),intent(inout) :: list + type(SELF_BoundaryCondition),pointer :: node,next_node + + node => list%head + do while(associated(node)) + next_node => node%next + nullify(node%bcMethod) + if allocated(node%elements) deallocate(node%elements) + if allocated(node%sides) deallocate(node%sides) + deallocate(node) + node => next_node + enddo + + call Init_BCList(list) + endsubroutine Free_BCList + + subroutine MoveNext(list) + class(BoundaryConditionList),intent(inout) :: list + if(associated(list%current%next)) then + list%current => list%current%next + else + nullify(list%current) + endif + endsubroutine MoveNext + + subroutine rewind(list) + class(BoundaryConditionList),intent(inout) :: list + list%current => list%head + endsubroutine rewind + + function GetBCForID(list,bcid) result(node) + !! This function returns the node associated with the given bcid + !! and context. If the bcid is not found, a null pointer is returned. + class(BoundaryConditionList),intent(in) :: list + integer,intent(in) :: bcid + type(SELF_BoundaryCondition),pointer :: node + + node => list%head + + do while(associated(node)) + if(node%bcid == bcid) then + return + endif + node => node%next + enddo + ! If we reach this point, the bcid was not found + ! and we return a null pointer + node => null() + + endfunction GetBCForID + + subroutine RegisterbcMethod(list,bcid,bcname,bcfunc,nboundaries) + !! Register a boundary condition function + !! with the given bcid and bcname. If the bcid + !! is already registered, the function is updated. + !! The function is expected to be a pointer to a + !! SELF_bcMethod type. + class(BoundaryConditionList),intent(inout) :: list + integer,intent(in) :: bcid + character(*),intent(in) :: bcname + procedure(SELF_bcMethod),pointer,intent(in) :: bcfunc + integer,intent(in) :: nboundaries + ! Local + type(SELF_BoundaryCondition),pointer :: bc + + ! Check if bcid is registered + bc => list%GetBCForID(bcid) + if(associated(bc)) then + ! If the bcid is already registered, we do not register it again + print*,"Boundary condition with ID ",bcid," is already registered." + print*,"Assigning new function to existing BC" + bc%bcMethod => bcfunc + else + allocate(bc) + bc%bcid = bcid + bc%bcname = trim(bcname) + bc%bcMethod => bcfunc + allocate(bc%elements(1:nboundaries)) + allocate(bc%sides(1:nboundaries)) + bc%nBoundaries = nboundaries + nullify(bc%next) + nullify(bc%prev) + + ! Insert at the tail + if(.not. associated(list%head)) then + ! First entry + list%head => bc + list%tail => bc + else + ! Append to tail + bc%prev => list%tail + list%tail%next => bc + list%tail => bc + endif + + list%nbc = list%nbc+1 + list%current => bc + + endif + + endsubroutine RegisterbcMethod + + subroutine RegisterBCGFunction(list,bcid,bcname,bcgfunc) + !! Register a boundary condition function + !! with the given bcid and bcname. If the bcid + !! is already registered, the function is updated. + !! The function is expected to be a pointer to a + !! SELF_BCGFunction type. + class(BoundaryConditionList),intent(inout) :: list + integer,intent(in) :: bcid + character(*),intent(in) :: bcname + procedure(SELF_BCGFunction),pointer,intent(in) :: bcgfunc + ! Local + type(SELF_BoundaryCondition),pointer :: bc + + ! Check if bcid is registered + bc => list%GetBCForID(bcid) + if(associated(bc)) then + ! If the bcid is already registered, we do not register it again + print*,"Boundary condition with ID ",bcid," is already registered." + print*,"Assigning new function to existing BC" + bc%bcgFunction => bcgfunc + else + allocate(bc) + bc%bcid = bcid + bc%bcname = trim(bcname) + bc%bcgFunction => bcgfunc + nullify(bc%next) + nullify(bc%prev) + + ! Insert at the tail + if(.not. associated(list%head)) then + ! First entry + list%head => bc + list%tail => bc + else + ! Append to tail + bc%prev => list%tail + list%tail%next => bc + list%tail => bc + endif + + list%nbc = list%nbc+1 + list%current => bc + + endif + + endsubroutine RegisterBCGFunction + +endmodule SELF_BoundaryConditions diff --git a/src/SELF_Burgers1D_t.f90 b/src/SELF_Burgers1D_t.f90 deleted file mode 100644 index 2996d548e..000000000 --- a/src/SELF_Burgers1D_t.f90 +++ /dev/null @@ -1,96 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUsLESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARIsLG IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_Burgers1D_t - - use self_model - use self_dgmodel1d - use self_mesh - - implicit none - - type,extends(dgmodel1d) :: Burgers1D_t - ! Add any additional attributes here that are specific to your model - real(prec) :: nu = 0.0_prec ! Diffusivity/viscosity - - contains - procedure :: SetMetadata => SetMetadata_Burgers1D_t - procedure :: entropy_func => entropy_func_Burgers1D_t - procedure :: flux1d => flux1d_Burgers1D_t - procedure :: riemannflux1d => riemannflux1d_Burgers1D_t - - endtype Burgers1D_t - -contains - subroutine SetMetadata_Burgers1D_t(this) - implicit none - class(Burgers1D_t),intent(inout) :: this - - call this%solution%SetName(1,"s") - call this%solution%SetUnits(1,"[null]") - - endsubroutine SetMetadata_Burgers1D_t - - pure function entropy_func_Burgers1D_t(this,s) result(e) - class(Burgers1D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec) :: e - - e = 0.5_prec*s(1)*s(1) - - endfunction entropy_func_Burgers1D_t - - pure function flux1d_Burgers1D_t(this,s,dsdx) result(flux) - class(Burgers1D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar) - real(prec) :: flux(1:this%solution%nvar) - - flux(1) = 0.5_prec*s(1)*s(1)-this%nu*dsdx(1) - - endfunction flux1d_Burgers1D_t - - pure function riemannflux1d_Burgers1D_t(this,sL,sR,dsdx,nhat) result(flux) - class(Burgers1D_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%solution%nvar) - real(prec),intent(in) :: sR(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar) - real(prec),intent(in) :: nhat - real(prec) :: flux(1:this%solution%nvar) - ! Local - real(prec) :: fL,fR,cmax - - ! Local Lax-Friedrich's flux - fL = 0.5_prec*sL(1)*sL(1)*nhat - fR = 0.5_prec*sR(1)*sR(1)*nhat - cmax = max(abs(sL(1)*nhat),abs(sR(1)*nhat)) ! maximum wave speed - - flux(1) = 0.5_prec*(fL+fR)+cmax*(sL(1)-sR(1)) & ! advective flux - -this%nu*dsdx(1)*nhat - - endfunction riemannflux1d_Burgers1D_t - -endmodule self_Burgers1D_t diff --git a/src/SELF_DGModel1D_t.f90 b/src/SELF_DGModel1D_t.f90 index a82f55cbe..25cbf0d6a 100644 --- a/src/SELF_DGModel1D_t.f90 +++ b/src/SELF_DGModel1D_t.f90 @@ -91,6 +91,7 @@ subroutine Init_DGModel1D_t(this,mesh,geometry) this%mesh => mesh this%geometry => geometry + this%ndim = 1 call this%SetNumberOfVariables() call this%solution%Init(geometry%x%interp,this%nvar,this%mesh%nElem) @@ -106,6 +107,8 @@ subroutine Init_DGModel1D_t(this,mesh,geometry) call this%flux%AssociateGeometry(geometry) call this%fluxDivergence%AssociateGeometry(geometry) + call this%boundaryconditions%Init() + call this%AdditionalInit() call this%SetMetadata() @@ -145,6 +148,7 @@ subroutine Free_DGModel1D_t(this) call this%flux%Free() call this%source%Free() call this%fluxDivergence%Free() + call this%boundaryconditions%Free() call this%AdditionalFree() endsubroutine Free_DGModel1D_t @@ -325,56 +329,29 @@ subroutine setboundarycondition_DGModel1D_t(this) ! local integer :: ivar integer :: N,nelem - real(prec) :: x + real(prec) :: x(1),nhat(1),s(1:this%nvar),dsdx(1:this%nvar,1),t + type(SELF_BoundaryCondition),pointer :: bc nelem = this%geometry%nelem ! number of elements in the mesh N = this%solution%interp%N ! polynomial degree - ! left-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(1,1,1) - this%solution%extBoundary(1,1,1:this%nvar) = & - this%hbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solution%extBoundary(1,1,1:this%nvar) = & - this%hbc1d_Radiation(this%solution%boundary(1,1,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solution%extBoundary(1,1,1:this%nvar) = & - this%hbc1d_NoNormalFlow(this%solution%boundary(1,1,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solution%extBoundary(1,1,1:this%nvar) = this%solution%boundary(2,nelem,1:this%nvar) - - endif - - ! right-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(2,nelem,1) - this%solution%extBoundary(2,nelem,1:this%nvar) = & - this%hbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solution%extBoundary(2,nelem,1:this%nvar) = & - this%hbc1d_Radiation(this%solution%boundary(2,nelem,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solution%extBoundary(2,nelem,1:this%nvar) = & - this%hbc1d_NoNormalFlow(this%solution%boundary(2,nelem,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solution%extBoundary(2,nelem,1:this%nvar) = this%solution%boundary(1,1,1:this%nvar) - - endif + ! Left boundary condition + bc => this%boundaryconditions%GetBCForID(this%mesh%bcid(1)) + x = this%geometry%x%boundary(1,1,1) + s = this%solution%boundary(1,1,1:this%nvar) + dsdx(1:this%nvar,1) = this%solutionGradient%boundary(1,1,1:this%nvar) + t = this%t + nhat = -1.0_prec + this%solution%extBoundary(1,1,1:this%nvar) = bc%bcFunction(s,dsdx,x,t,nhat,this%nvar,1) + + ! Right boundary condition + bc => this%boundaryconditions%GetBCForID(this%mesh%bcid(1)) + x = this%geometry%x%boundary(2,nelem,1) + s = this%solution%boundary(2,nelem,1:this%nvar) + dsdx(1:this%nvar,1) = this%solutionGradient%boundary(2,nelem,1:this%nvar) + t = this%t + nhat = 1.0_prec + this%solution%extBoundary(2,nelem,1:this%nvar) = bc%bcFunction(s,dsdx,x,t,nhat,this%nvar,1) endsubroutine setboundarycondition_DGModel1D_t @@ -387,56 +364,31 @@ subroutine setgradientboundarycondition_DGModel1D_t(this) implicit none class(DGModel1D_t),intent(inout) :: this ! local - real(prec) :: x + real(prec) :: x(1),nhat(1),s(1:this%nvar),dsdx(1:this%nvar,1),t + real(prec) :: exts(1:this%nvar,1) integer :: nelem + type(SELF_BoundaryCondition),pointer :: bc nelem = this%geometry%nelem ! number of elements in the mesh - - ! left-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(1,1,1) - this%solutionGradient%extBoundary(1,1,1:this%nvar) = & - this%pbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solutionGradient%extBoundary(1,1,1:this%nvar) = & - this%pbc1d_Radiation(this%solutionGradient%boundary(1,1,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solutionGradient%extBoundary(1,1,1:this%nvar) = & - this%pbc1d_NoNormalFlow(this%solutionGradient%boundary(1,1,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solutionGradient%extBoundary(1,1,1:this%nvar) = this%solutionGradient%boundary(2,nelem,1:this%nvar) - - endif - - ! right-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(2,nelem,1) - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = & - this%pbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = & - this%pbc1d_Radiation(this%solutionGradient%boundary(2,nelem,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = & - this%pbc1d_NoNormalFlow(this%solutionGradient%boundary(2,nelem,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = this%solutionGradient%boundary(1,1,1:this%nvar) - - endif + ! Left boundary condition + bc => this%boundaryconditions%GetBCForID(this%mesh%bcid(1)) + x(1) = this%geometry%x%boundary(1,1,1) + s = this%solution%boundary(1,1,1:this%nvar) + dsdx(1:this%nvar,1) = this%solutionGradient%boundary(1,1,1:this%nvar) + t = this%t + nhat = -1.0_prec + exts = bc%bcgFunction(s,dsdx,x,t,nhat,this%nvar,1) + this%solutiongradient%extBoundary(1,1,1:this%nvar) = exts(1:this%nvar,1) + + ! Right boundary condition + bc => this%boundaryconditions%GetBCForID(this%mesh%bcid(1)) + x(1) = this%geometry%x%boundary(2,nelem,1) + s = this%solution%boundary(2,nelem,1:this%nvar) + dsdx(1:this%nvar,1) = this%solutionGradient%boundary(2,nelem,1:this%nvar) + t = this%t + nhat = 1.0_prec + exts = bc%bcgFunction(s,dsdx,x,t,nhat,this%nvar,1) + this%solutiongradient%extBoundary(2,nelem,1:this%nvar) = exts(1:this%nvar,1) endsubroutine setgradientboundarycondition_DGModel1D_t diff --git a/src/SELF_DGModel2D_t.f90 b/src/SELF_DGModel2D_t.f90 index c3e0f84aa..91944c49b 100644 --- a/src/SELF_DGModel2D_t.f90 +++ b/src/SELF_DGModel2D_t.f90 @@ -98,6 +98,7 @@ subroutine Init_DGModel2D_t(this,mesh,geometry) this%mesh => mesh this%geometry => geometry + this%ndim = 2 call this%SetNumberOfVariables() call this%solution%Init(geometry%x%interp,this%nvar,this%mesh%nElem) @@ -113,6 +114,8 @@ subroutine Init_DGModel2D_t(this,mesh,geometry) call this%flux%AssociateGeometry(geometry) call this%fluxDivergence%AssociateGeometry(geometry) + call this%boundaryconditions%Init() + call this%AdditionalInit() call this%SetMetadata() @@ -147,6 +150,7 @@ subroutine Free_DGModel2D_t(this) call this%flux%Free() call this%source%Free() call this%fluxDivergence%Free() + call this%boundaryconditions%Free() call this%AdditionalFree() endsubroutine Free_DGModel2D_t @@ -444,44 +448,30 @@ subroutine setboundarycondition_DGModel2D_t(this) class(DGModel2D_t),intent(inout) :: this ! local integer :: i,iEl,j,e2,bcid - real(prec) :: nhat(1:2),x(1:2) - - do concurrent(j=1:4,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,iEl,1,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_Prescribed(x,this%t) - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) + real(prec) :: nhat(1:2),x(1:2),s(1:this%nvar),dsdx(1:this%nvar,1:2) + type(SELF_BoundaryCondition),pointer :: bc - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_Radiation(this%solution%boundary(i,j,iEl,1:this%nvar),nhat) - enddo + do iel = 1,this%mesh%nElem + do j = 1,4 - elseif(bcid == SELF_BC_NONORMALFLOW) then + bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID + e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points + if(e2 == 0) then + bc => this%boundaryconditions%GetBCForID(bcid) + do concurrent(i=1:this%solution%N+1) + ! Get the boundary normals on cell edges from the mesh geometry nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) + x = this%geometry%x%boundary(i,j,iEl,1,1:2) + s = this%solution%boundary(i,j,iEl,1:this%nvar) + dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_NoNormalFlow(this%solution%boundary(i,j,iEl,1:this%nvar),nhat) + bc%bcFunction(s,dsdx,x,this%t,nhat,this%nvar,2) enddo - endif - endif + enddo enddo endsubroutine setboundarycondition_DGModel2D_t @@ -494,49 +484,28 @@ subroutine setgradientboundarycondition_DGModel2D_t(this) class(DGModel2D_t),intent(inout) :: this ! local integer :: i,iEl,j,e2,bcid - real(prec) :: dsdx(1:this%nvar,1:2) - real(prec) :: nhat(1:2),x(1:2) - - do concurrent(j=1:4,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,iEl,1,1:2) - - this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & - this%pbc2d_Prescribed(x,this%t) - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - - dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) - - this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & - this%pbc2d_Radiation(dsdx,nhat) - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points + real(prec) :: nhat(1:2),x(1:2),s(1:this%nvar),dsdx(1:this%nvar,1:2) + type(SELF_BoundaryCondition),pointer :: bc + + do iel = 1,this%mesh%nElem + do j = 1,4 + bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID + e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID + + if(e2 == 0) then + bc => this%boundaryconditions%GetBCForID(bcid) + do concurrent(i=1:this%solution%N+1) + ! Get the boundary normals on cell edges from the mesh geometry nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - + x = this%geometry%x%boundary(i,j,iEl,1,1:2) + s = this%solution%boundary(i,j,iEl,1:this%nvar) dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & - this%pbc2d_NoNormalFlow(dsdx,nhat) + bc%bcgFunction(s,dsdx,x,this%t,nhat,this%nvar,2) enddo - endif - endif - + enddo enddo endsubroutine setgradientboundarycondition_DGModel2D_t diff --git a/src/SELF_DGModel3D_t.f90 b/src/SELF_DGModel3D_t.f90 index dd6a303ef..0bd98356c 100644 --- a/src/SELF_DGModel3D_t.f90 +++ b/src/SELF_DGModel3D_t.f90 @@ -98,6 +98,7 @@ subroutine Init_DGModel3D_t(this,mesh,geometry) this%mesh => mesh this%geometry => geometry + this%ndim = 3 call this%SetNumberOfVariables() call this%solution%Init(geometry%x%interp,this%nvar,this%mesh%nElem) @@ -113,6 +114,8 @@ subroutine Init_DGModel3D_t(this,mesh,geometry) call this%flux%AssociateGeometry(geometry) call this%fluxDivergence%AssociateGeometry(geometry) + call this%boundaryconditions%Init() + call this%AdditionalInit() call this%SetMetadata() @@ -147,6 +150,7 @@ subroutine Free_DGModel3D_t(this) call this%flux%Free() call this%source%Free() call this%fluxDivergence%Free() + call this%boundaryconditions%Free() call this%AdditionalFree() endsubroutine Free_DGModel3D_t @@ -440,50 +444,31 @@ subroutine setboundarycondition_DGModel3D_t(this) class(DGModel3D_t),intent(inout) :: this ! local integer :: i,iEl,j,k,e2,bcid - real(prec) :: nhat(1:3),x(1:3) - - do concurrent(k=1:6,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,k,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_Prescribed(x,this%t) - enddo - enddo - - elseif(bcid == SELF_BC_RADIATION) then + real(prec) :: nhat(1:3),x(1:3),s(1:this%nvar),dsdx(1:this%nvar,1:3) + type(SELF_BoundaryCondition),pointer :: bc - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) + do iel = 1,this%mesh%nElem + do k = 1,6 - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_Radiation(this%solution%boundary(i,j,k,iEl,1:this%nvar),nhat) - enddo - enddo + bcid = this%mesh%sideInfo(5,k,iEl) ! Boundary Condition ID + e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID - elseif(bcid == SELF_BC_NONORMALFLOW) then + if(e2 == 0) then + bc => this%boundaryconditions%GetBCForID(bcid) - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) + do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1) + ! Get the boundary normals on cell edges from the mesh geometry + nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) + x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) + s = this%solution%boundary(i,j,k,iEl,1:this%nvar) + dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_NoNormalFlow(this%solution%boundary(i,j,k,iEl,1:this%nvar),nhat) - enddo + this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & + bc%bcFunction(s,dsdx,x,this%t,nhat,this%nvar,3) enddo - endif - endif + enddo enddo endsubroutine setboundarycondition_DGModel3D_t @@ -496,55 +481,28 @@ subroutine setgradientboundarycondition_DGModel3D_t(this) class(DGModel3D_t),intent(inout) :: this ! local integer :: i,iEl,j,k,e2,bcid - real(prec) :: dsdx(1:this%nvar,1:3) - real(prec) :: nhat(1:3),x(1:3) - - do concurrent(k=1:6,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,k,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do j = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - x = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & - this%pbc3d_Prescribed(x,this%t) - enddo - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do j = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) - - this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & - this%pbc3d_Radiation(dsdx,nhat) - enddo - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - - do j = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) - - this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & - this%pbc3d_NoNormalFlow(dsdx,nhat) - enddo + real(prec) :: nhat(1:3),x(1:3),s(1:this%nvar),dsdx(1:this%nvar,1:3) + type(SELF_BoundaryCondition),pointer :: bc + + do iel = 1,this%mesh%nElem + do k = 1,6 + bcid = this%mesh%sideInfo(5,k,iEl) ! Boundary Condition ID + e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID + + if(e2 == 0) then + bc => this%boundaryconditions%GetBCForID(bcid) + do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1) + ! Get the boundary normals on cell edges from the mesh geometry + nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) + x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) + s = this%solution%boundary(i,j,k,iEl,1:this%nvar) + dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) + + this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & + bc%bcgFunction(s,dsdx,x,this%t,nhat,this%nvar,3) enddo - endif - endif - + enddo enddo endsubroutine setgradientboundarycondition_DGModel3D_t diff --git a/src/SELF_Geometry.f90 b/src/SELF_Geometry.f90 new file mode 100644 index 000000000..c2038b992 --- /dev/null +++ b/src/SELF_Geometry.f90 @@ -0,0 +1,36 @@ +module SELF_Geometry + + use SELF_Constants + use SELF_Lagrange + + implicit none + + type,abstract :: SEMGeometry + integer :: nElem + contains + + procedure(SELF_InitGeometry),deferred :: Init + procedure(SELF_FreeGeometry),deferred:: Free + + endtype SEMGeometry + + interface + subroutine SELF_InitGeometry(this,interp,nElem) + import SEMGeometry + import Lagrange + implicit none + class(SEMGeometry),intent(out) :: this + type(Lagrange),pointer,intent(in) :: interp + integer,intent(in) :: nElem + endsubroutine SELF_InitGeometry + endinterface + + interface + subroutine SELF_FreeGeometry(this) + import SEMGeometry + implicit none + class(SEMGeometry),intent(inout) :: this + endsubroutine SELF_FreeGeometry + endinterface + +endmodule SELF_Geometry diff --git a/src/SELF_Geometry_1D.f90 b/src/SELF_Geometry_1D.f90 index 549b902d6..9e94dd005 100644 --- a/src/SELF_Geometry_1D.f90 +++ b/src/SELF_Geometry_1D.f90 @@ -32,13 +32,13 @@ module SELF_Geometry_1D use SELF_Scalar_1D use SELF_SupportRoutines use SELF_Mesh_1D + use SELF_Geometry implicit none - type,public :: Geometry1D + type,extends(SEMGeometry),public :: Geometry1D type(Scalar1D) :: x ! Physical Positions type(Scalar1D) :: dxds ! Conversion from computational to physical space - integer :: nElem contains @@ -53,38 +53,38 @@ module SELF_Geometry_1D contains - subroutine Init_Geometry1D(myGeom,interp,nElem) + subroutine Init_Geometry1D(this,interp,nElem) implicit none - class(Geometry1D),intent(out) :: myGeom + class(Geometry1D),intent(out) :: this type(Lagrange),pointer,intent(in) :: interp integer,intent(in) :: nElem - myGeom%nElem = nElem + this%nElem = nElem - call myGeom%x%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%x%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%dxds%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%dxds%Init(interp=interp, & + nVar=1, & + nElem=nElem) endsubroutine Init_Geometry1D - subroutine Free_Geometry1D(myGeom) + subroutine Free_Geometry1D(this) implicit none - class(Geometry1D),intent(inout) :: myGeom + class(Geometry1D),intent(inout) :: this - call myGeom%x%Free() - call myGeom%dxds%Free() + call this%x%Free() + call this%dxds%Free() endsubroutine Free_Geometry1D - subroutine GenerateFromMesh_Geometry1D(myGeom,mesh) + subroutine GenerateFromMesh_Geometry1D(this,mesh) ! Generates the geometry for a 1-D mesh ( set of line segments ) ! Assumes that mesh is using Gauss-Lobatto quadrature and the degree is given by mesh % nGeo implicit none - class(Geometry1D),intent(inout) :: myGeom + class(Geometry1D),intent(inout) :: this type(Mesh1D),intent(in) :: mesh ! Local integer :: iel,i,nid @@ -92,8 +92,8 @@ subroutine GenerateFromMesh_Geometry1D(myGeom,mesh) type(Scalar1D) :: xMesh call meshToModel%Init(mesh%nGeo,mesh%quadrature, & - myGeom%x%interp%N, & - myGeom%x%interp%controlNodeType) + this%x%interp%N, & + this%x%interp%controlNodeType) call xMesh%Init(meshToModel, & 1,mesh%nElem) @@ -108,11 +108,11 @@ subroutine GenerateFromMesh_Geometry1D(myGeom,mesh) enddo ! Interpolate from the mesh hopr_nodeCoords to the geometry (Possibly not gauss_lobatto quadrature) - call xMesh%GridInterp(myGeom%x%interior) - call myGeom%x%UpdateDevice() - call myGeom%x%BoundaryInterp() + call xMesh%GridInterp(this%x%interior) + call this%x%UpdateDevice() + call this%x%BoundaryInterp() - call myGeom%CalculateMetricTerms() + call this%CalculateMetricTerms() call xMesh%Free() @@ -120,19 +120,19 @@ subroutine GenerateFromMesh_Geometry1D(myGeom,mesh) endsubroutine GenerateFromMesh_Geometry1D - subroutine CalculateMetricTerms_Geometry1D(myGeom) + subroutine CalculateMetricTerms_Geometry1D(this) implicit none - class(Geometry1D),intent(inout) :: myGeom + class(Geometry1D),intent(inout) :: this - call myGeom%x%Derivative(myGeom%dxds%interior) - call myGeom%dxds%UpdateDevice() - call myGeom%dxds%BoundaryInterp() + call this%x%Derivative(this%dxds%interior) + call this%dxds%UpdateDevice() + call this%dxds%BoundaryInterp() endsubroutine CalculateMetricTerms_Geometry1D - subroutine Write_Geometry1D(myGeom,fileName) + subroutine Write_Geometry1D(this,fileName) implicit none - class(Geometry1D),intent(in) :: myGeom + class(Geometry1D),intent(in) :: this character(*),optional,intent(in) :: fileName ! Local integer(HID_T) :: fileId @@ -150,16 +150,16 @@ subroutine Write_Geometry1D(myGeom,fileName) call CreateGroup_HDF5(fileId,'/quadrature') call WriteArray_HDF5(fileId,'/quadrature/xi', & - myGeom%x%interp%controlPoints) + this%x%interp%controlPoints) call WriteArray_HDF5(fileId,'/quadrature/weights', & - myGeom%x%interp%qWeights) + this%x%interp%qWeights) call WriteArray_HDF5(fileId,'/quadrature/dgmatrix', & - myGeom%x%interp%dgMatrix) + this%x%interp%dgMatrix) call WriteArray_HDF5(fileId,'/quadrature/dmatrix', & - myGeom%x%interp%dMatrix) + this%x%interp%dMatrix) call CreateGroup_HDF5(fileId,'/mesh') @@ -167,13 +167,13 @@ subroutine Write_Geometry1D(myGeom,fileName) call CreateGroup_HDF5(fileId,'/mesh/boundary') - call WriteArray_HDF5(fileId,'/mesh/interior/x',myGeom%x%interior) + call WriteArray_HDF5(fileId,'/mesh/interior/x',this%x%interior) - call WriteArray_HDF5(fileId,'/mesh/interior/dxds',myGeom%dxds%interior) + call WriteArray_HDF5(fileId,'/mesh/interior/dxds',this%dxds%interior) - call WriteArray_HDF5(fileId,'/mesh/boundary/x',myGeom%x%boundary) + call WriteArray_HDF5(fileId,'/mesh/boundary/x',this%x%boundary) - call WriteArray_HDF5(fileId,'/mesh/boundary/dxds',myGeom%dxds%boundary) + call WriteArray_HDF5(fileId,'/mesh/boundary/dxds',this%dxds%boundary) call Close_HDF5(fileId) diff --git a/src/SELF_Geometry_2D.f90 b/src/SELF_Geometry_2D.f90 index 64033f314..75af20195 100644 --- a/src/SELF_Geometry_2D.f90 +++ b/src/SELF_Geometry_2D.f90 @@ -34,17 +34,17 @@ module SELF_Geometry_2D use SELF_Tensor_2D use SELF_SupportRoutines use SELF_Mesh_2D + use SELF_Geometry implicit none - type,public :: SEMQuad + type,extends(SEMGeometry),public :: SEMQuad type(Vector2D) :: x ! Physical positions type(Tensor2D) :: dxds ! Covariant basis vectors type(Tensor2D) :: dsdx ! Contavariant basis vectors type(Vector2D) :: nHat ! Normal Vectors pointing across coordinate lines type(Scalar2D) :: nScale ! Boundary scale type(Scalar2D) :: J ! Jacobian of the transformation - integer :: nElem contains procedure,public :: Init => Init_SEMQuad @@ -58,58 +58,58 @@ module SELF_Geometry_2D contains - subroutine Init_SEMQuad(myGeom,interp,nElem) + subroutine Init_SEMQuad(this,interp,nElem) implicit none - class(SEMQuad),intent(out) :: myGeom + class(SEMQuad),intent(out) :: this type(Lagrange),pointer,intent(in) :: interp integer,intent(in) :: nElem - myGeom%nElem = nElem + this%nElem = nElem - call myGeom%x%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%x%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%x%meta(1)%SetName("x") + call this%x%meta(1)%SetName("x") - call myGeom%dxds%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%dxds%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%dsdx%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%dsdx%Init(interp=interp, & + nVar=1, & + nElem=nElem) + + call this%nHat%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%nHat%Init(interp=interp, & + call this%nScale%Init(interp=interp, & nVar=1, & nElem=nElem) - call myGeom%nScale%Init(interp=interp, & - nVar=1, & - nElem=nElem) - - call myGeom%J%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%J%Init(interp=interp, & + nVar=1, & + nElem=nElem) endsubroutine Init_SEMQuad - subroutine Free_SEMQuad(myGeom) + subroutine Free_SEMQuad(this) implicit none - class(SEMQuad),intent(inout) :: myGeom + class(SEMQuad),intent(inout) :: this - call myGeom%x%Free() - call myGeom%dxds%Free() - call myGeom%dsdx%Free() - call myGeom%nHat%Free() - call myGeom%nScale%Free() - call myGeom%J%Free() + call this%x%Free() + call this%dxds%Free() + call this%dsdx%Free() + call this%nHat%Free() + call this%nScale%Free() + call this%J%Free() endsubroutine Free_SEMQuad - subroutine GenerateFromMesh_SEMQuad(myGeom,mesh) + subroutine GenerateFromMesh_SEMQuad(this,mesh) implicit none - class(SEMQuad),intent(inout) :: myGeom + class(SEMQuad),intent(inout) :: this type(Mesh2D),intent(in) :: mesh ! Local integer :: iel @@ -119,8 +119,8 @@ subroutine GenerateFromMesh_SEMQuad(myGeom,mesh) call meshToModel%Init(mesh%nGeo, & mesh%quadrature, & - myGeom%x%interp%N, & - myGeom%x%interp%controlNodeType) + this%x%interp%N, & + this%x%interp%controlNodeType) call xMesh%Init(meshToModel,1,mesh%nElem) @@ -133,20 +133,20 @@ subroutine GenerateFromMesh_SEMQuad(myGeom,mesh) enddo enddo - call xMesh%GridInterp(myGeom%x%interior) - call myGeom%x%UpdateDevice() - call myGeom%x%BoundaryInterp() ! Boundary interp will run on GPU if enabled, hence why we close in update host/device - call myGeom%x%UpdateHost() - call myGeom%CalculateMetricTerms() + call xMesh%GridInterp(this%x%interior) + call this%x%UpdateDevice() + call this%x%BoundaryInterp() ! Boundary interp will run on GPU if enabled, hence why we close in update host/device + call this%x%UpdateHost() + call this%CalculateMetricTerms() call xMesh%Free() call meshToModel%Free() endsubroutine GenerateFromMesh_SEMQuad - subroutine CalculateContravariantBasis_SEMQuad(myGeom) + subroutine CalculateContravariantBasis_SEMQuad(this) implicit none - class(SEMQuad),intent(inout) :: myGeom + class(SEMQuad),intent(inout) :: this ! Local integer :: iEl,i,j,k real(prec) :: fac @@ -155,104 +155,104 @@ subroutine CalculateContravariantBasis_SEMQuad(myGeom) ! Now calculate the contravariant basis vectors ! In this convention, dsdx(j,i) is contravariant vector i, component j ! To project onto contravariant vector i, dot vector along the first dimension - do iEl = 1,myGeom%nElem - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 + do iEl = 1,this%nElem + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 - myGeom%dsdx%interior(i,j,iel,1,1,1) = myGeom%dxds%interior(i,j,iel,1,2,2) - myGeom%dsdx%interior(i,j,iel,1,2,1) = -myGeom%dxds%interior(i,j,iel,1,1,2) - myGeom%dsdx%interior(i,j,iel,1,1,2) = -myGeom%dxds%interior(i,j,iel,1,2,1) - myGeom%dsdx%interior(i,j,iel,1,2,2) = myGeom%dxds%interior(i,j,iel,1,1,1) + this%dsdx%interior(i,j,iel,1,1,1) = this%dxds%interior(i,j,iel,1,2,2) + this%dsdx%interior(i,j,iel,1,2,1) = -this%dxds%interior(i,j,iel,1,1,2) + this%dsdx%interior(i,j,iel,1,1,2) = -this%dxds%interior(i,j,iel,1,2,1) + this%dsdx%interior(i,j,iel,1,2,2) = this%dxds%interior(i,j,iel,1,1,1) enddo enddo enddo ! Interpolate the contravariant tensor to the boundaries - call myGeom%dsdx%BoundaryInterp() ! Tensor boundary interp is not offloaded + call this%dsdx%BoundaryInterp() ! Tensor boundary interp is not offloaded ! Now, modify the sign of dsdx so that - ! myGeom % dsdx % boundary is equal to the outward pointing normal vector - do iEl = 1,myGeom%nElem + ! this % dsdx % boundary is equal to the outward pointing normal vector + do iEl = 1,this%nElem do k = 1,4 - do i = 1,myGeom%J%interp%N+1 + do i = 1,this%J%interp%N+1 if(k == selfSide2D_East .or. k == selfSide2D_North) then - fac = sign(1.0_prec,myGeom%J%boundary(i,k,iEl,1)) + fac = sign(1.0_prec,this%J%boundary(i,k,iEl,1)) else - fac = -sign(1.0_prec,myGeom%J%boundary(i,k,iEl,1)) + fac = -sign(1.0_prec,this%J%boundary(i,k,iEl,1)) endif if(k == 1) then ! South - mag = sqrt(myGeom%dsdx%boundary(i,k,iEl,1,1,2)**2+ & - myGeom%dsdx%boundary(i,k,iEl,1,2,2)**2) + mag = sqrt(this%dsdx%boundary(i,k,iEl,1,1,2)**2+ & + this%dsdx%boundary(i,k,iEl,1,2,2)**2) - myGeom%nScale%boundary(i,k,iEl,1) = mag + this%nScale%boundary(i,k,iEl,1) = mag - myGeom%nHat%boundary(i,k,iEl,1,1:2) = & - fac*myGeom%dsdx%boundary(i,k,iEl,1,1:2,2)/mag + this%nHat%boundary(i,k,iEl,1,1:2) = & + fac*this%dsdx%boundary(i,k,iEl,1,1:2,2)/mag elseif(k == 2) then ! East - mag = sqrt(myGeom%dsdx%boundary(i,k,iEl,1,1,1)**2+ & - myGeom%dsdx%boundary(i,k,iEl,1,2,1)**2) + mag = sqrt(this%dsdx%boundary(i,k,iEl,1,1,1)**2+ & + this%dsdx%boundary(i,k,iEl,1,2,1)**2) - myGeom%nScale%boundary(i,k,iEl,1) = mag + this%nScale%boundary(i,k,iEl,1) = mag - myGeom%nHat%boundary(i,k,iEl,1,1:2) = & - fac*myGeom%dsdx%boundary(i,k,iEl,1,1:2,1)/mag + this%nHat%boundary(i,k,iEl,1,1:2) = & + fac*this%dsdx%boundary(i,k,iEl,1,1:2,1)/mag elseif(k == 3) then ! North - mag = sqrt(myGeom%dsdx%boundary(i,k,iEl,1,1,2)**2+ & - myGeom%dsdx%boundary(i,k,iEl,1,2,2)**2) + mag = sqrt(this%dsdx%boundary(i,k,iEl,1,1,2)**2+ & + this%dsdx%boundary(i,k,iEl,1,2,2)**2) - myGeom%nScale%boundary(i,k,iEl,1) = mag + this%nScale%boundary(i,k,iEl,1) = mag - myGeom%nHat%boundary(i,k,iEl,1,1:2) = & - fac*myGeom%dsdx%boundary(i,k,iEl,1,1:2,2)/mag + this%nHat%boundary(i,k,iEl,1,1:2) = & + fac*this%dsdx%boundary(i,k,iEl,1,1:2,2)/mag elseif(k == 4) then ! West - mag = sqrt(myGeom%dsdx%boundary(i,k,iEl,1,1,1)**2+ & - myGeom%dsdx%boundary(i,k,iEl,1,2,1)**2) + mag = sqrt(this%dsdx%boundary(i,k,iEl,1,1,1)**2+ & + this%dsdx%boundary(i,k,iEl,1,2,1)**2) - myGeom%nScale%boundary(i,k,iEl,1) = mag + this%nScale%boundary(i,k,iEl,1) = mag - myGeom%nHat%boundary(i,k,iEl,1,1:2) = & - fac*myGeom%dsdx%boundary(i,k,iEl,1,1:2,1)/mag + this%nHat%boundary(i,k,iEl,1,1:2) = & + fac*this%dsdx%boundary(i,k,iEl,1,1:2,1)/mag endif ! Set the directionality for dsdx on the boundaries - myGeom%dsdx%boundary(i,k,iEl,1,1:2,1:2) = & - myGeom%dsdx%boundary(i,k,iEl,1,1:2,1:2)*fac + this%dsdx%boundary(i,k,iEl,1,1:2,1:2) = & + this%dsdx%boundary(i,k,iEl,1,1:2,1:2)*fac enddo enddo enddo - call myGeom%dsdx%UpdateDevice() - call myGeom%nHat%UpdateDevice() - call myGeom%nScale%UpdateDevice() + call this%dsdx%UpdateDevice() + call this%nHat%UpdateDevice() + call this%nScale%UpdateDevice() endsubroutine CalculateContravariantBasis_SEMQuad - subroutine CalculateMetricTerms_SEMQuad(myGeom) + subroutine CalculateMetricTerms_SEMQuad(this) implicit none - class(SEMQuad),intent(inout) :: myGeom + class(SEMQuad),intent(inout) :: this - call myGeom%x%Gradient(myGeom%dxds%interior) - call myGeom%dxds%BoundaryInterp() ! Tensor boundary interp is not offloaded to GPU - call myGeom%dxds%UpdateDevice() + call this%x%Gradient(this%dxds%interior) + call this%dxds%BoundaryInterp() ! Tensor boundary interp is not offloaded to GPU + call this%dxds%UpdateDevice() - call myGeom%dxds%Determinant(myGeom%J%interior) + call this%dxds%Determinant(this%J%interior) - call myGeom%J%UpdateDevice() - call myGeom%J%BoundaryInterp() - call myGeom%J%UpdateHost() + call this%J%UpdateDevice() + call this%J%BoundaryInterp() + call this%J%UpdateHost() - call myGeom%CalculateContravariantBasis() + call this%CalculateContravariantBasis() endsubroutine CalculateMetricTerms_SEMQuad diff --git a/src/SELF_Geometry_3D.f90 b/src/SELF_Geometry_3D.f90 index 8c35a191a..a957e8c53 100644 --- a/src/SELF_Geometry_3D.f90 +++ b/src/SELF_Geometry_3D.f90 @@ -34,17 +34,17 @@ module SELF_Geometry_3D use SELF_Tensor_3D use SELF_SupportRoutines use SELF_Mesh_3D + use SELF_Geometry implicit none - type,public :: SEMHex + type,extends(SEMGeometry),public :: SEMHex type(Vector3D) :: x ! Physical positions type(Tensor3D) :: dxds ! Covariant basis vectors type(Tensor3D) :: dsdx ! Contavariant basis vectors type(Vector3D) :: nHat ! Normal Vectors pointing across coordinate lines type(Scalar3D) :: nScale ! Boundary scale type(Scalar3D) :: J ! Jacobian of the transformation - integer :: nElem contains @@ -59,58 +59,58 @@ module SELF_Geometry_3D contains - subroutine Init_SEMHex(myGeom,interp,nElem) + subroutine Init_SEMHex(this,interp,nElem) implicit none - class(SEMHex),intent(out) :: myGeom + class(SEMHex),intent(out) :: this type(Lagrange),pointer,intent(in) :: interp integer,intent(in) :: nElem - myGeom%nElem = nElem + this%nElem = nElem - call myGeom%x%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%x%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%x%meta(1)%SetName("x") + call this%x%meta(1)%SetName("x") - call myGeom%dxds%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%dxds%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%dsdx%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%dsdx%Init(interp=interp, & + nVar=1, & + nElem=nElem) + + call this%nHat%Init(interp=interp, & + nVar=1, & + nElem=nElem) - call myGeom%nHat%Init(interp=interp, & + call this%nScale%Init(interp=interp, & nVar=1, & nElem=nElem) - call myGeom%nScale%Init(interp=interp, & - nVar=1, & - nElem=nElem) - - call myGeom%J%Init(interp=interp, & - nVar=1, & - nElem=nElem) + call this%J%Init(interp=interp, & + nVar=1, & + nElem=nElem) endsubroutine Init_SEMHex - subroutine Free_SEMHex(myGeom) + subroutine Free_SEMHex(this) implicit none - class(SEMHex),intent(inout) :: myGeom + class(SEMHex),intent(inout) :: this - call myGeom%x%Free() - call myGeom%dxds%Free() - call myGeom%dsdx%Free() - call myGeom%nHat%Free() - call myGeom%nScale%Free() - call myGeom%J%Free() + call this%x%Free() + call this%dxds%Free() + call this%dsdx%Free() + call this%nHat%Free() + call this%nScale%Free() + call this%J%Free() endsubroutine Free_SEMHex - subroutine GenerateFromMesh_SEMHex(myGeom,mesh) + subroutine GenerateFromMesh_SEMHex(this,mesh) implicit none - class(SEMHex),intent(inout) :: myGeom + class(SEMHex),intent(inout) :: this type(Mesh3D),intent(in) :: mesh ! Local integer :: iel @@ -119,8 +119,8 @@ subroutine GenerateFromMesh_SEMHex(myGeom,mesh) type(Vector3D) :: xMesh call meshToModel%Init(mesh%nGeo,mesh%quadrature, & - myGeom%x%interp%N, & - myGeom%x%interp%controlNodeType) + this%x%interp%N, & + this%x%interp%controlNodeType) call xMesh%Init(meshToModel, & 1,mesh%nElem) @@ -136,20 +136,20 @@ subroutine GenerateFromMesh_SEMHex(myGeom,mesh) enddo enddo - call xMesh%GridInterp(myGeom%x%interior) - call myGeom%x%UpdateDevice() - call myGeom%x%BoundaryInterp() - call myGeom%x%UpdateHost() - call myGeom%CalculateMetricTerms() + call xMesh%GridInterp(this%x%interior) + call this%x%UpdateDevice() + call this%x%BoundaryInterp() + call this%x%UpdateHost() + call this%CalculateMetricTerms() call xMesh%Free() call meshToModel%Free() endsubroutine GenerateFromMesh_SEMHex - subroutine CalculateContravariantBasis_SEMHex(myGeom) + subroutine CalculateContravariantBasis_SEMHex(this) implicit none - class(SEMHex),intent(inout) :: myGeom + class(SEMHex),intent(inout) :: this ! Local integer :: iEl,i,j,k real(prec) :: fac @@ -159,19 +159,19 @@ subroutine CalculateContravariantBasis_SEMHex(myGeom) ! Here we use the curl invariant form from Kopriva (2006) ! to calculate the contravariant basis vectors - call xlgradxm%Init(myGeom%x%interp,1,myGeom%x%nElem) - call xmgradxl%Init(myGeom%x%interp,1,myGeom%x%nElem) + call xlgradxm%Init(this%x%interp,1,this%x%nElem) + call xmgradxl%Init(this%x%interp,1,this%x%nElem) - call curl_xlgradxm%Init(myGeom%x%interp,1,myGeom%x%nElem) - call curl_xmgradxl%Init(myGeom%x%interp,1,myGeom%x%nElem) + call curl_xlgradxm%Init(this%x%interp,1,this%x%nElem) + call curl_xmgradxl%Init(this%x%interp,1,this%x%nElem) ! Ja^{1:3}_1 (n=1, m=2, l=3) First component of the contravariant basis vectors - do iEl = 1,myGeom%nElem - do k = 1,myGeom%dxds%interp%N+1 - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 - xlgradxm%interior(i,j,k,iel,1,1:3) = myGeom%x%interior(i,j,k,iel,1,3)*myGeom%dxds%interior(i,j,k,iel,1,2,1:3) ! x(...,l)*dxds(...,m,1:3) ; l=3,m=2 - xmgradxl%interior(i,j,k,iel,1,1:3) = myGeom%x%interior(i,j,k,iel,1,2)*myGeom%dxds%interior(i,j,k,iel,1,3,1:3) ! x(...,m)*dxds(...,l,1:3) ; l=3,m=2 + do iEl = 1,this%nElem + do k = 1,this%dxds%interp%N+1 + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 + xlgradxm%interior(i,j,k,iel,1,1:3) = this%x%interior(i,j,k,iel,1,3)*this%dxds%interior(i,j,k,iel,1,2,1:3) ! x(...,l)*dxds(...,m,1:3) ; l=3,m=2 + xmgradxl%interior(i,j,k,iel,1,1:3) = this%x%interior(i,j,k,iel,1,2)*this%dxds%interior(i,j,k,iel,1,3,1:3) ! x(...,m)*dxds(...,l,1:3) ; l=3,m=2 enddo enddo enddo @@ -180,28 +180,28 @@ subroutine CalculateContravariantBasis_SEMHex(myGeom) call xlgradxm%Curl(curl_xlgradxm%interior) call xmgradxl%Curl(curl_xmgradxl%interior) - do iEl = 1,myGeom%nElem - do k = 1,myGeom%dxds%interp%N+1 - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 + do iEl = 1,this%nElem + do k = 1,this%dxds%interp%N+1 + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 ! In our convention, dsdx(i,j) is contravariant vector j, component i ! dsdx(...,n,i) = Ja^{i}_{n} = contravariant vector i, component n; ! Here, i = 1:3, and n=1 - myGeom%dsdx%interior(i,j,k,iel,1,1,1:3) = 0.5_prec*( & - curl_xmgradxl%interior(i,j,k,iel,1,1:3)- & - curl_xlgradxm%interior(i,j,k,iel,1,1:3)) + this%dsdx%interior(i,j,k,iel,1,1,1:3) = 0.5_prec*( & + curl_xmgradxl%interior(i,j,k,iel,1,1:3)- & + curl_xlgradxm%interior(i,j,k,iel,1,1:3)) enddo enddo enddo enddo ! Ja^{1:3}_2 (n=2, m=3, l=1) Second component of the contravariant basis vectors - do iEl = 1,myGeom%nElem - do k = 1,myGeom%dxds%interp%N+1 - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 - xlgradxm%interior(i,j,k,iel,1,1:3) = myGeom%x%interior(i,j,k,iel,1,1)*myGeom%dxds%interior(i,j,k,iel,1,3,1:3) ! x(...,l)*dxds(...,m,1:3) ; l=1,m=3 - xmgradxl%interior(i,j,k,iel,1,1:3) = myGeom%x%interior(i,j,k,iel,1,3)*myGeom%dxds%interior(i,j,k,iel,1,1,1:3) ! x(...,m)*dxds(...,l,1:3) ; l=1,m=3 + do iEl = 1,this%nElem + do k = 1,this%dxds%interp%N+1 + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 + xlgradxm%interior(i,j,k,iel,1,1:3) = this%x%interior(i,j,k,iel,1,1)*this%dxds%interior(i,j,k,iel,1,3,1:3) ! x(...,l)*dxds(...,m,1:3) ; l=1,m=3 + xmgradxl%interior(i,j,k,iel,1,1:3) = this%x%interior(i,j,k,iel,1,3)*this%dxds%interior(i,j,k,iel,1,1,1:3) ! x(...,m)*dxds(...,l,1:3) ; l=1,m=3 enddo enddo enddo @@ -210,28 +210,28 @@ subroutine CalculateContravariantBasis_SEMHex(myGeom) call xlgradxm%Curl(curl_xlgradxm%interior) call xmgradxl%Curl(curl_xmgradxl%interior) - do iEl = 1,myGeom%nElem - do k = 1,myGeom%dxds%interp%N+1 - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 + do iEl = 1,this%nElem + do k = 1,this%dxds%interp%N+1 + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 ! In our convention, dsdx(i,j) is contravariant vector j, component i ! dsdx(...,n,i) = Ja^{i}_{n} = contravariant vector i, component n; ! Here, i = 1:3, and n=2 - myGeom%dsdx%interior(i,j,k,iel,1,2,1:3) = 0.5_prec*( & - curl_xmgradxl%interior(i,j,k,iel,1,1:3)- & - curl_xlgradxm%interior(i,j,k,iel,1,1:3)) + this%dsdx%interior(i,j,k,iel,1,2,1:3) = 0.5_prec*( & + curl_xmgradxl%interior(i,j,k,iel,1,1:3)- & + curl_xlgradxm%interior(i,j,k,iel,1,1:3)) enddo enddo enddo enddo ! Ja^{1:3}_3 (n=3, m=1, l=2) Third component of the contravariant basis vectors - do iEl = 1,myGeom%nElem - do k = 1,myGeom%dxds%interp%N+1 - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 - xlgradxm%interior(i,j,k,iel,1,1:3) = myGeom%x%interior(i,j,k,iel,1,2)*myGeom%dxds%interior(i,j,k,iel,1,1,1:3) ! x(...,l)*dxds(...,m,1:3) ; l=2,m=1 - xmgradxl%interior(i,j,k,iel,1,1:3) = myGeom%x%interior(i,j,k,iel,1,1)*myGeom%dxds%interior(i,j,k,iel,1,2,1:3) ! x(...,m)*dxds(...,l,1:3) ; l=2,m=1 + do iEl = 1,this%nElem + do k = 1,this%dxds%interp%N+1 + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 + xlgradxm%interior(i,j,k,iel,1,1:3) = this%x%interior(i,j,k,iel,1,2)*this%dxds%interior(i,j,k,iel,1,1,1:3) ! x(...,l)*dxds(...,m,1:3) ; l=2,m=1 + xmgradxl%interior(i,j,k,iel,1,1:3) = this%x%interior(i,j,k,iel,1,1)*this%dxds%interior(i,j,k,iel,1,2,1:3) ! x(...,m)*dxds(...,l,1:3) ; l=2,m=1 enddo enddo enddo @@ -240,16 +240,16 @@ subroutine CalculateContravariantBasis_SEMHex(myGeom) call xlgradxm%Curl(curl_xlgradxm%interior) call xmgradxl%Curl(curl_xmgradxl%interior) - do iEl = 1,myGeom%nElem - do k = 1,myGeom%dxds%interp%N+1 - do j = 1,myGeom%dxds%interp%N+1 - do i = 1,myGeom%dxds%interp%N+1 + do iEl = 1,this%nElem + do k = 1,this%dxds%interp%N+1 + do j = 1,this%dxds%interp%N+1 + do i = 1,this%dxds%interp%N+1 ! In our convention, dsdx(i,j) is contravariant vector j, component i ! dsdx(...,n,i) = Ja^{i}_{n} = contravariant vector i, component n; ! Here, i = 1:3, and n=3 - myGeom%dsdx%interior(i,j,k,iel,1,3,1:3) = 0.5_prec*( & - curl_xmgradxl%interior(i,j,k,iel,1,1:3)- & - curl_xlgradxm%interior(i,j,k,iel,1,1:3)) + this%dsdx%interior(i,j,k,iel,1,3,1:3) = 0.5_prec*( & + curl_xmgradxl%interior(i,j,k,iel,1,1:3)- & + curl_xlgradxm%interior(i,j,k,iel,1,1:3)) enddo enddo enddo @@ -261,118 +261,118 @@ subroutine CalculateContravariantBasis_SEMHex(myGeom) call curl_xmgradxl%Free() ! Interpolate the contravariant tensor to the boundaries - call myGeom%dsdx%BoundaryInterp() ! Tensor boundary interp is not offloaded + call this%dsdx%BoundaryInterp() ! Tensor boundary interp is not offloaded ! Now, calculate nHat (outward pointing normal) - do iEl = 1,myGeom%nElem + do iEl = 1,this%nElem do k = 1,6 - do j = 1,myGeom%J%interp%N+1 - do i = 1,myGeom%J%interp%N+1 + do j = 1,this%J%interp%N+1 + do i = 1,this%J%interp%N+1 if(k == selfSide3D_Top .or. k == selfSide3D_East .or. k == selfSide3D_North) then - fac = sign(1.0_prec,myGeom%J%boundary(i,j,k,iEl,1)) + fac = sign(1.0_prec,this%J%boundary(i,j,k,iEl,1)) else - fac = -sign(1.0_prec,myGeom%J%boundary(i,j,k,iEl,1)) + fac = -sign(1.0_prec,this%J%boundary(i,j,k,iEl,1)) endif if(k == 1) then ! Bottom - mag = sqrt(myGeom%dsdx%boundary(i,j,k,iEl,1,1,3)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,2,3)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,3,3)**2) + mag = sqrt(this%dsdx%boundary(i,j,k,iEl,1,1,3)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,2,3)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,3,3)**2) - myGeom%nScale%boundary(i,j,k,iEl,1) = mag + this%nScale%boundary(i,j,k,iEl,1) = mag - myGeom%nHat%boundary(i,j,k,iEl,1,1:3) = & - fac*myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,3)/mag + this%nHat%boundary(i,j,k,iEl,1,1:3) = & + fac*this%dsdx%boundary(i,j,k,iEl,1,1:3,3)/mag ! Set the directionality for dsdx on the boundaries ! This is primarily used for DG gradient calculations, ! which do not use nHat for the boundary terms. - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,3) = & - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,3)*fac + this%dsdx%boundary(i,j,k,iEl,1,1:3,3) = & + this%dsdx%boundary(i,j,k,iEl,1,1:3,3)*fac elseif(k == 2) then ! South - mag = sqrt(myGeom%dsdx%boundary(i,j,k,iEl,1,1,2)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,2,2)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,3,2)**2) + mag = sqrt(this%dsdx%boundary(i,j,k,iEl,1,1,2)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,2,2)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,3,2)**2) - myGeom%nScale%boundary(i,j,k,iEl,1) = mag + this%nScale%boundary(i,j,k,iEl,1) = mag - myGeom%nHat%boundary(i,j,k,iEl,1,1:3) = & - fac*myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,2)/mag + this%nHat%boundary(i,j,k,iEl,1,1:3) = & + fac*this%dsdx%boundary(i,j,k,iEl,1,1:3,2)/mag ! Set the directionality for dsdx on the boundaries ! This is primarily used for DG gradient calculations, ! which do not use nHat for the boundary terms. - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,2) = & - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,2)*fac + this%dsdx%boundary(i,j,k,iEl,1,1:3,2) = & + this%dsdx%boundary(i,j,k,iEl,1,1:3,2)*fac elseif(k == 3) then ! East - mag = sqrt(myGeom%dsdx%boundary(i,j,k,iEl,1,1,1)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,2,1)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,3,1)**2) + mag = sqrt(this%dsdx%boundary(i,j,k,iEl,1,1,1)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,2,1)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,3,1)**2) - myGeom%nScale%boundary(i,j,k,iEl,1) = mag + this%nScale%boundary(i,j,k,iEl,1) = mag - myGeom%nHat%boundary(i,j,k,iEl,1,1:3) = & - fac*myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,1)/mag + this%nHat%boundary(i,j,k,iEl,1,1:3) = & + fac*this%dsdx%boundary(i,j,k,iEl,1,1:3,1)/mag ! Set the directionality for dsdx on the boundaries ! This is primarily used for DG gradient calculations, ! which do not use nHat for the boundary terms. - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,1) = & - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,1)*fac + this%dsdx%boundary(i,j,k,iEl,1,1:3,1) = & + this%dsdx%boundary(i,j,k,iEl,1,1:3,1)*fac elseif(k == 4) then ! North - mag = sqrt(myGeom%dsdx%boundary(i,j,k,iEl,1,1,2)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,2,2)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,3,2)**2) + mag = sqrt(this%dsdx%boundary(i,j,k,iEl,1,1,2)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,2,2)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,3,2)**2) - myGeom%nScale%boundary(i,j,k,iEl,1) = mag + this%nScale%boundary(i,j,k,iEl,1) = mag - myGeom%nHat%boundary(i,j,k,iEl,1,1:3) = & - fac*myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,2)/mag + this%nHat%boundary(i,j,k,iEl,1,1:3) = & + fac*this%dsdx%boundary(i,j,k,iEl,1,1:3,2)/mag ! Set the directionality for dsdx on the boundaries ! This is primarily used for DG gradient calculations, ! which do not use nHat for the boundary terms. - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,2) = & - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,2)*fac + this%dsdx%boundary(i,j,k,iEl,1,1:3,2) = & + this%dsdx%boundary(i,j,k,iEl,1,1:3,2)*fac elseif(k == 5) then ! West - mag = sqrt(myGeom%dsdx%boundary(i,j,k,iEl,1,1,1)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,2,1)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,3,1)**2) + mag = sqrt(this%dsdx%boundary(i,j,k,iEl,1,1,1)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,2,1)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,3,1)**2) - myGeom%nScale%boundary(i,j,k,iEl,1) = mag + this%nScale%boundary(i,j,k,iEl,1) = mag - myGeom%nHat%boundary(i,j,k,iEl,1,1:3) = & - fac*myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,1)/mag + this%nHat%boundary(i,j,k,iEl,1,1:3) = & + fac*this%dsdx%boundary(i,j,k,iEl,1,1:3,1)/mag ! Set the directionality for dsdx on the boundaries ! This is primarily used for DG gradient calculations, ! which do not use nHat for the boundary terms. - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,1) = & - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,1)*fac + this%dsdx%boundary(i,j,k,iEl,1,1:3,1) = & + this%dsdx%boundary(i,j,k,iEl,1,1:3,1)*fac elseif(k == 6) then ! Top - mag = sqrt(myGeom%dsdx%boundary(i,j,k,iEl,1,1,3)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,2,3)**2+ & - myGeom%dsdx%boundary(i,j,k,iEl,1,3,3)**2) + mag = sqrt(this%dsdx%boundary(i,j,k,iEl,1,1,3)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,2,3)**2+ & + this%dsdx%boundary(i,j,k,iEl,1,3,3)**2) - myGeom%nScale%boundary(i,j,k,iEl,1) = mag + this%nScale%boundary(i,j,k,iEl,1) = mag - myGeom%nHat%boundary(i,j,k,iEl,1,1:3) = & - fac*myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,3)/mag + this%nHat%boundary(i,j,k,iEl,1,1:3) = & + fac*this%dsdx%boundary(i,j,k,iEl,1,1:3,3)/mag ! Set the directionality for dsdx on the boundaries ! This is primarily used for DG gradient calculations, ! which do not use nHat for the boundary terms. - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,3) = & - myGeom%dsdx%boundary(i,j,k,iEl,1,1:3,3)*fac + this%dsdx%boundary(i,j,k,iEl,1,1:3,3) = & + this%dsdx%boundary(i,j,k,iEl,1,1:3,3)*fac endif @@ -381,27 +381,27 @@ subroutine CalculateContravariantBasis_SEMHex(myGeom) enddo enddo - call myGeom%dsdx%UpdateDevice() - call myGeom%nHat%UpdateDevice() - call myGeom%nScale%UpdateDevice() + call this%dsdx%UpdateDevice() + call this%nHat%UpdateDevice() + call this%nScale%UpdateDevice() endsubroutine CalculateContravariantBasis_SEMHex - subroutine CalculateMetricTerms_SEMHex(myGeom) + subroutine CalculateMetricTerms_SEMHex(this) implicit none - class(SEMHex),intent(inout) :: myGeom + class(SEMHex),intent(inout) :: this - call myGeom%x%Gradient(myGeom%dxds%interior) - call myGeom%dxds%BoundaryInterp() ! Tensor boundary interp is not offloaded to GPU - call myGeom%dxds%UpdateDevice() + call this%x%Gradient(this%dxds%interior) + call this%dxds%BoundaryInterp() ! Tensor boundary interp is not offloaded to GPU + call this%dxds%UpdateDevice() - call myGeom%dxds%Determinant(myGeom%J%interior) + call this%dxds%Determinant(this%J%interior) - call myGeom%J%UpdateDevice() - call myGeom%J%BoundaryInterp() - call myGeom%J%UpdateHost() + call this%J%UpdateDevice() + call this%J%BoundaryInterp() + call this%J%UpdateHost() - call myGeom%CalculateContravariantBasis() + call this%CalculateContravariantBasis() endsubroutine CalculateMetricTerms_SEMHex diff --git a/src/SELF_LinearEuler2D_t.f90 b/src/SELF_LinearEuler2D_t.f90 deleted file mode 100644 index b716f30e9..000000000 --- a/src/SELF_LinearEuler2D_t.f90 +++ /dev/null @@ -1,238 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUsLESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARIsLG IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearEuler2D_t -!! This module defines a class that can be used to solve the Linear Euler -!! equations in 2-D. The Linear Euler Equations, here, are the Euler equations -!! linearized about a motionless background state. -!! -!! The conserved variables are - -!! \begin{equation} -!! \vec{s} = \begin{pmatrix} -!! \rho \\ -!! u \\ -!! v \\ -!! p -!! \end{pmatrix} -!! \end{equation} -!! -!! The conservative flux is -!! -!! \begin{equation} -!! \overleftrightarrow{f} = \begin{pmatrix} -!! \rho_0 u \hat{x} + \rho_0 v \hat{y} \\ -!! \frac{p}{\rho_0} \hat{x} \\ -!! \frac{p}{\rho_0} \hat{y} \\ -!! c^2 \rho_0 ( u \hat{x} + v \hat{y} ) -!! \end{pmatrix} -!! \end{equation} -!! -!! and the source terms are null. -!! - - use self_model - use self_dgmodel2d - use self_mesh - - implicit none - - type,extends(dgmodel2d) :: LinearEuler2D_t - ! Add any additional attributes here that are specific to your model - real(prec) :: rho0 = 1.0_prec ! Reference density - real(prec) :: c = 1.0_prec ! Sound speed - real(prec) :: g = 0.0_prec ! gravitational acceleration (y-direction only) - - contains - procedure :: SetNumberOfVariables => SetNumberOfVariables_LinearEuler2D_t - procedure :: SetMetadata => SetMetadata_LinearEuler2D_t - procedure :: entropy_func => entropy_func_LinearEuler2D_t - procedure :: hbc2d_NoNormalFlow => hbc2d_NoNormalFlow_LinearEuler2D_t - procedure :: flux2d => flux2d_LinearEuler2D_t - procedure :: riemannflux2d => riemannflux2d_LinearEuler2D_t - !procedure :: source2d => source2d_LinearEuler2D_t - procedure :: SphericalSoundWave => SphericalSoundWave_LinearEuler2D_t - - endtype LinearEuler2D_t - -contains - - subroutine SetNumberOfVariables_LinearEuler2D_t(this) - implicit none - class(LinearEuler2D_t),intent(inout) :: this - - this%nvar = 4 - - endsubroutine SetNumberOfVariables_LinearEuler2D_t - - subroutine SetMetadata_LinearEuler2D_t(this) - implicit none - class(LinearEuler2D_t),intent(inout) :: this - - call this%solution%SetName(1,"rho") ! Density - call this%solution%SetUnits(1,"kg⋅m⁻³") - - call this%solution%SetName(2,"u") ! x-velocity component - call this%solution%SetUnits(2,"m⋅s⁻¹") - - call this%solution%SetName(3,"v") ! y-velocity component - call this%solution%SetUnits(3,"m⋅s⁻¹") - - call this%solution%SetName(4,"P") ! Pressure - call this%solution%SetUnits(4,"kg⋅m⁻¹⋅s⁻²") - - endsubroutine SetMetadata_LinearEuler2D_t - - pure function entropy_func_LinearEuler2D_t(this,s) result(e) - !! The entropy function is the sum of kinetic and internal energy - !! For the linear model, this is - !! - !! \begin{equation} - !! e = \frac{1}{2} \left( \rho_0*( u^2 + v^2 ) + \frac{P^2}{\rho_0 c^2} \right) - class(LinearEuler2D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec) :: e - - e = 0.5_prec*this%rho0*(s(2)*s(2)+s(3)*(3))+ & - 0.5_prec*(s(4)*s(4)/(this%rho0*this%c*this%c)) - - endfunction entropy_func_LinearEuler2D_t - - pure function hbc2d_NoNormalFlow_LinearEuler2D_t(this,s,nhat) result(exts) - class(LinearEuler2D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - exts(1) = s(1) ! density - exts(2) = (nhat(2)**2-nhat(1)**2)*s(2)-2.0_prec*nhat(1)*nhat(2)*s(3) ! u - exts(3) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! v - exts(4) = s(4) ! p - - endfunction hbc2d_NoNormalFlow_LinearEuler2D_t - - pure function flux2d_LinearEuler2D_t(this,s,dsdx) result(flux) - class(LinearEuler2D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:2) - real(prec) :: flux(1:this%nvar,1:2) - - flux(1,1) = this%rho0*s(2) ! density, x flux ; rho0*u - flux(1,2) = this%rho0*s(3) ! density, y flux ; rho0*v - flux(2,1) = s(4)/this%rho0 ! x-velocity, x flux; p/rho0 - flux(2,2) = 0.0_prec ! x-velocity, y flux; 0 - flux(3,1) = 0.0_prec ! y-velocity, x flux; 0 - flux(3,2) = s(4)/this%rho0 ! y-velocity, y flux; p/rho0 - flux(4,1) = this%c*this%c*this%rho0*s(2) ! pressure, x flux : rho0*c^2*u - flux(4,2) = this%c*this%c*this%rho0*s(3) ! pressure, y flux : rho0*c^2*v - - endfunction flux2d_LinearEuler2D_t - - pure function riemannflux2d_LinearEuler2D_t(this,sL,sR,dsdx,nhat) result(flux) - !! Uses a local lax-friedrich's upwind flux - !! The max eigenvalue is taken as the sound speed - class(LinearEuler2D_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%nvar) - real(prec),intent(in) :: sR(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:2) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: flux(1:this%nvar) - ! Local - real(prec) :: fL(1:this%nvar) - real(prec) :: fR(1:this%nvar) - real(prec) :: u,v,p,c,rho0 - - u = sL(2) - v = sL(3) - p = sL(4) - rho0 = this%rho0 - c = this%c - fL(1) = rho0*(u*nhat(1)+v*nhat(2)) ! density - fL(2) = p*nhat(1)/rho0 ! u - fL(3) = p*nhat(2)/rho0 ! v - fL(4) = rho0*c*c*(u*nhat(1)+v*nhat(2)) ! pressure - - u = sR(2) - v = sR(3) - p = sR(4) - fR(1) = rho0*(u*nhat(1)+v*nhat(2)) ! density - fR(2) = p*nhat(1)/rho0 ! u - fR(3) = p*nhat(2)/rho0 ! v - fR(4) = rho0*c*c*(u*nhat(1)+v*nhat(2)) ! pressure - - flux(1:4) = 0.5_prec*(fL(1:4)+fR(1:4))+c*(sL(1:4)-sR(1:4)) - - endfunction riemannflux2d_LinearEuler2D_t - - subroutine SphericalSoundWave_LinearEuler2D_t(this,rhoprime,Lr,x0,y0) - !! This subroutine sets the initial condition for a weak blast wave - !! problem. The initial condition is given by - !! - !! \begin{equation} - !! \begin{aligned} - !! \rho &= \rho_0 + \rho' \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_r^2} \right) - !! u &= 0 \\ - !! v &= 0 \\ - !! E &= \frac{P_0}{\gamma - 1} + E \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_e^2} \right) - !! \end{aligned} - !! \end{equation} - !! - implicit none - class(LinearEuler2D_t),intent(inout) :: this - real(prec),intent(in) :: rhoprime,Lr,x0,y0 - ! Local - integer :: i,j,iEl - real(prec) :: x,y,rho,r,E - - print*,__FILE__," : Configuring weak blast wave initial condition. " - print*,__FILE__," : rhoprime = ",rhoprime - print*,__FILE__," : Lr = ",Lr - print*,__FILE__," : x0 = ",x0 - print*,__FILE__," : y0 = ",y0 - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - iel=1:this%mesh%nElem) - x = this%geometry%x%interior(i,j,iEl,1,1)-x0 - y = this%geometry%x%interior(i,j,iEl,1,2)-y0 - r = sqrt(x**2+y**2) - - rho = (rhoprime)*exp(-log(2.0_prec)*r**2/Lr**2) - - this%solution%interior(i,j,iEl,1) = rho - this%solution%interior(i,j,iEl,2) = 0.0_prec - this%solution%interior(i,j,iEl,3) = 0.0_prec - this%solution%interior(i,j,iEl,4) = rho*this%c*this%c - - enddo - - call this%ReportMetrics() - call this%solution%UpdateDevice() - - endsubroutine SphericalSoundWave_LinearEuler2D_t - -endmodule self_LinearEuler2D_t diff --git a/src/SELF_LinearEuler3D_t.f90 b/src/SELF_LinearEuler3D_t.f90 deleted file mode 100644 index cf059fdfb..000000000 --- a/src/SELF_LinearEuler3D_t.f90 +++ /dev/null @@ -1,269 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUsLESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARIsLG IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearEuler3D_t -!! This module defines a class that can be used to solve the Linear Euler -!! equations in 3-D. The Linear Euler Equations, here, are the Euler equations -!! linearized about a motionless background state. -!! -!! The conserved variables are - -!! \begin{equation} -!! \vec{s} = \begin{pmatrix} -!! \rho \\ -!! u \\ -!! v \\ -!! w \\ -!! p -!! \end{pmatrix} -!! \end{equation} -!! -!! The conservative flux is -!! -!! \begin{equation} -!! \overleftrightarrow{f} = \begin{pmatrix} -!! \rho_0 u \hat{x} + \rho_0 v \hat{y} + \rho_0 w \hat{z} \\ -!! \frac{p}{\rho_0} \hat{x} \\ -!! \frac{p}{\rho_0} \hat{y} \\ -!! \frac{p}{\rho_0} \hat{z} \\ -!! c^2 \rho_0 ( u \hat{x} + v \hat{y} + w \hat{z}) -!! \end{pmatrix} -!! \end{equation} -!! -!! and the source terms are null. -!! - - use self_model - use self_dgmodel3D - use self_mesh - - implicit none - - type,extends(dgmodel3D) :: LinearEuler3D_t - ! Add any additional attributes here that are specific to your model - real(prec) :: rho0 = 1.0_prec ! Reference density - real(prec) :: c = 1.0_prec ! Sound speed - real(prec) :: g = 0.0_prec ! gravitational acceleration (y-direction only) - - contains - procedure :: SourceMethod => sourcemethod_LinearEuler3D_t - procedure :: SetNumberOfVariables => SetNumberOfVariables_LinearEuler3D_t - procedure :: SetMetadata => SetMetadata_LinearEuler3D_t - procedure :: entropy_func => entropy_func_LinearEuler3D_t - !procedure :: hbc3D_NoNormalFlow => hbc3D_NoNormalFlow_LinearEuler3D_t - procedure :: flux3D => flux3D_LinearEuler3D_t - procedure :: riemannflux3D => riemannflux3D_LinearEuler3D_t - procedure :: SphericalSoundWave => SphericalSoundWave_LinearEuler3D_t - - endtype LinearEuler3D_t - -contains - - subroutine SetNumberOfVariables_LinearEuler3D_t(this) - implicit none - class(LinearEuler3D_t),intent(inout) :: this - - this%nvar = 5 - - endsubroutine SetNumberOfVariables_LinearEuler3D_t - - subroutine SetMetadata_LinearEuler3D_t(this) - implicit none - class(LinearEuler3D_t),intent(inout) :: this - - call this%solution%SetName(1,"rho") ! Density - call this%solution%SetUnits(1,"kg⋅m⁻³") - - call this%solution%SetName(2,"u") ! x-velocity component - call this%solution%SetUnits(2,"m⋅s⁻¹") - - call this%solution%SetName(3,"v") ! y-velocity component - call this%solution%SetUnits(3,"m⋅s⁻¹") - - call this%solution%SetName(4,"w") ! z-velocity component - call this%solution%SetUnits(4,"m⋅s⁻¹") - - call this%solution%SetName(5,"P") ! Pressure - call this%solution%SetUnits(5,"kg⋅m⁻¹⋅s⁻²") - - endsubroutine SetMetadata_LinearEuler3D_t - - pure function entropy_func_LinearEuler3D_t(this,s) result(e) - !! The entropy function is the sum of kinetic and internal energy - !! For the linear model, this is - !! - !! \begin{equation} - !! e = \frac{1}{2} \left( \rho_0*( u^2 + v^2 ) + \frac{P^2}{\rho_0 c^2} \right) - class(LinearEuler3D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec) :: e - - e = 0.5_prec*this%rho0*(s(2)*s(2)+s(3)*(3)+s(4)*s(4))+ & - 0.5_prec*(s(5)*s(5)/(this%rho0*this%c*this%c)) - - endfunction entropy_func_LinearEuler3D_t - - ! pure function hbc3D_NoNormalFlow_LinearEuler3D_t(this,s,nhat) result(exts) - ! class(LinearEuler3D_t),intent(in) :: this - ! real(prec),intent(in) :: s(1:this%nvar) - ! real(prec),intent(in) :: nhat(1:2) - ! real(prec) :: exts(1:this%nvar) - ! ! Local - ! integer :: ivar - - ! exts(1) = s(1) ! density - ! exts(2) = (nhat(2)**2-nhat(1)**2)*s(2)-2.0_prec*nhat(1)*nhat(2)*s(3) ! u - ! exts(3) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! v - ! exts(4) = (nhat(1)**2-nhat(2)**2)*s(3)-2.0_prec*nhat(1)*nhat(2)*s(2) ! w - ! exts(5) = s(4) ! p - - ! endfunction hbc3D_NoNormalFlow_LinearEuler3D_t - subroutine sourcemethod_LinearEuler3D_t(this) - implicit none - class(LinearEuler3D_t),intent(inout) :: this - - return - - endsubroutine sourcemethod_LinearEuler3D_t - - pure function flux3D_LinearEuler3D_t(this,s,dsdx) result(flux) - class(LinearEuler3D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:3) - real(prec) :: flux(1:this%nvar,1:3) - - flux(1,1) = this%rho0*s(2) ! density, x flux ; rho0*u - flux(1,2) = this%rho0*s(3) ! density, y flux ; rho0*v - flux(1,3) = this%rho0*s(4) ! density, y flux ; rho0*w - - flux(2,1) = s(5)/this%rho0 ! x-velocity, x flux; p/rho0 - flux(2,2) = 0.0_prec ! x-velocity, y flux; 0 - flux(2,3) = 0.0_prec ! x-velocity, z flux; 0 - - flux(3,1) = 0.0_prec ! y-velocity, x flux; 0 - flux(3,2) = s(5)/this%rho0 ! y-velocity, y flux; p/rho0 - flux(3,3) = 0.0_prec ! y-velocity, z flux; 0 - - flux(4,1) = 0.0_prec ! z-velocity, x flux; 0 - flux(4,2) = 0.0_prec ! z-velocity, y flux; 0 - flux(4,3) = s(5)/this%rho0 ! z-velocity, z flux; p/rho0 - - flux(5,1) = this%c*this%c*this%rho0*s(2) ! pressure, x flux : rho0*c^2*u - flux(5,2) = this%c*this%c*this%rho0*s(3) ! pressure, y flux : rho0*c^2*v - flux(5,3) = this%c*this%c*this%rho0*s(4) ! pressure, y flux : rho0*c^2*w - - endfunction flux3D_LinearEuler3D_t - - pure function riemannflux3D_LinearEuler3D_t(this,sL,sR,dsdx,nhat) result(flux) - !! Uses a local lax-friedrich's upwind flux - !! The max eigenvalue is taken as the sound speed - class(LinearEuler3D_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%nvar) - real(prec),intent(in) :: sR(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:3) - real(prec),intent(in) :: nhat(1:3) - real(prec) :: flux(1:this%nvar) - ! Local - real(prec) :: fL(1:this%nvar) - real(prec) :: fR(1:this%nvar) - real(prec) :: u,v,w,p,c,rho0 - - u = sL(2) - v = sL(3) - w = sL(4) - p = sL(5) - rho0 = this%rho0 - c = this%c - fL(1) = rho0*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! density - fL(2) = p*nhat(1)/rho0 ! u - fL(3) = p*nhat(2)/rho0 ! v - fL(4) = p*nhat(3)/rho0 ! w - fL(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure - - u = sR(2) - v = sR(3) - w = sR(4) - p = sR(5) - fR(1) = rho0*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! density - fR(2) = p*nhat(1)/rho0 ! u - fR(3) = p*nhat(2)/rho0 ! v' - fR(4) = p*nhat(3)/rho0 ! w - fR(5) = rho0*c*c*(u*nhat(1)+v*nhat(2)+w*nhat(3)) ! pressure - - flux(1:5) = 0.5_prec*(fL(1:5)+fR(1:5))+c*(sL(1:5)-sR(1:5)) - - endfunction riemannflux3D_LinearEuler3D_t - - subroutine SphericalSoundWave_LinearEuler3D_t(this,rhoprime,Lr,x0,y0,z0) - !! This subroutine sets the initial condition for a weak blast wave - !! problem. The initial condition is given by - !! - !! \begin{equation} - !! \begin{aligned} - !! \rho &= \rho_0 + \rho' \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_r^2} \right) - !! u &= 0 \\ - !! v &= 0 \\ - !! E &= \frac{P_0}{\gamma - 1} + E \exp\left( -\ln(2) \frac{(x-x_0)^2 + (y-y_0)^2}{L_e^2} \right) - !! \end{aligned} - !! \end{equation} - !! - implicit none - class(LinearEuler3D_t),intent(inout) :: this - real(prec),intent(in) :: rhoprime,Lr,x0,y0,z0 - ! Local - integer :: i,j,k,iEl - real(prec) :: x,y,z,rho,r,E - - print*,__FILE__," : Configuring weak blast wave initial condition. " - print*,__FILE__," : rhoprime = ",rhoprime - print*,__FILE__," : Lr = ",Lr - print*,__FILE__," : x0 = ",x0 - print*,__FILE__," : y0 = ",y0 - print*,__FILE__," : z0 = ",z0 - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - k=1:this%solution%N+1,iel=1:this%mesh%nElem) - x = this%geometry%x%interior(i,j,k,iEl,1,1)-x0 - y = this%geometry%x%interior(i,j,k,iEl,1,2)-y0 - z = this%geometry%x%interior(i,j,k,iEl,1,3)-z0 - r = sqrt(x**2+y**2+z**2) - - rho = (rhoprime)*exp(-log(2.0_prec)*r**2/Lr**2) - - this%solution%interior(i,j,k,iEl,1) = rho - this%solution%interior(i,j,k,iEl,2) = 0.0_prec - this%solution%interior(i,j,k,iEl,3) = 0.0_prec - this%solution%interior(i,j,k,iEl,4) = 0.0_prec - this%solution%interior(i,j,k,iEl,5) = rho*this%c*this%c - - enddo - - call this%ReportMetrics() - call this%solution%UpdateDevice() - - endsubroutine SphericalSoundWave_LinearEuler3D_t - -endmodule self_LinearEuler3D_t diff --git a/src/SELF_LinearShallowWater2D_t.f90 b/src/SELF_LinearShallowWater2D_t.f90 deleted file mode 100644 index 69121d622..000000000 --- a/src/SELF_LinearShallowWater2D_t.f90 +++ /dev/null @@ -1,257 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearShallowWater2D_t - use self_model - use self_dgmodel2d - use self_mesh - - implicit none - - type,extends(dgmodel2d) :: LinearShallowWater2D_t - real(prec) :: H = 0.0_prec ! uniform resting depth - real(prec) :: g = 0.0_prec ! acceleration due to gravity - real(prec) :: Cd = 0.0_prec ! Linear drag coefficient (1/s) - type(MappedScalar2D) :: fCori ! The coriolis parameter - - contains - procedure :: AdditionalInit => AdditionalInit_LinearShallowWater2D_t - procedure :: AdditionalFree => AdditionalFree_LinearShallowWater2D_t - procedure :: SetNumberOfVariables => SetNumberOfVariables_LinearShallowWater2D_t - procedure :: SetMetadata => SetMetadata_LinearShallowWater2D_t - procedure :: entropy_func => entropy_func_LinearShallowWater2D_t - procedure :: flux2d => flux2d_LinearShallowWater2D_t - procedure :: riemannflux2d => riemannflux2d_LinearShallowWater2D_t - procedure :: hbc2d_NoNormalFlow => hbc2d_NoNormalFlow_LinearShallowWater2D_t - procedure :: sourcemethod => sourcemethod_LinearShallowWater2D_t - ! Custom methods - generic,public :: SetCoriolis => SetCoriolis_fplane_LinearShallowWater2D_t, & - SetCoriolis_betaplane_LinearShallowWater2D_t - procedure,private :: SetCoriolis_fplane_LinearShallowWater2D_t - procedure,private :: SetCoriolis_betaplane_LinearShallowWater2D_t - - procedure,public :: DiagnoseGeostrophicVelocity => DiagnoseGeostrophicVelocity_LinearShallowWater2D_t - - endtype LinearShallowWater2D_t - -contains - - subroutine AdditionalInit_LinearShallowWater2D_t(this) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - - call this%fCori%Init(this%geometry%x%interp, & - 1,this%mesh%nElem) - - endsubroutine AdditionalInit_LinearShallowWater2D_t - - subroutine AdditionalFree_LinearShallowWater2D_t(this) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - - call this%fCori%Free() - - endsubroutine AdditionalFree_LinearShallowWater2D_t - - subroutine SetNumberOfVariables_LinearShallowWater2D_t(this) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - - this%nvar = 3 - - endsubroutine SetNumberOfVariables_LinearShallowWater2D_t - - subroutine SetCoriolis_fplane_LinearShallowWater2D_t(this,f0) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - real(prec),intent(in) :: f0 - ! Local - integer :: iel - integer :: i - integer :: j - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - iel=1:this%mesh%nElem) - this%fCori%interior(i,j,iel,1) = f0 - enddo - call this%fCori%UpdateDevice() - - endsubroutine SetCoriolis_fplane_LinearShallowWater2D_t - - subroutine SetCoriolis_betaplane_LinearShallowWater2D_t(this,f0,beta) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - real(prec),intent(in) :: f0 - real(prec),intent(in) :: beta - ! Local - integer :: iel - integer :: i - integer :: j - real(prec) :: y - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - iel=1:this%mesh%nElem) - y = this%geometry%x%interior(i,j,iel,1,2) - this%fCori%interior(i,j,iel,1) = f0+beta*y - enddo - call this%fCori%UpdateDevice() - - endsubroutine SetCoriolis_betaplane_LinearShallowWater2D_t - - subroutine DiagnoseGeostrophicVelocity_LinearShallowWater2D_t(this) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - ! Local - integer :: iel - integer :: i - integer :: j - real(prec) :: dpdx,dpdy,f - - ! We assume here that the velocity field is identically zero - ! everywhere and the only field that is set is the free surface height - ! with a non-zero coriolis parameter. - ! In this case, we have that the tendency calculation will give - ! the gradient in the free surface, consistent with the DG approximation - this%solution%interior(:,:,:,1) = 0.0_prec ! Set u=0 - this%solution%interior(:,:,:,2) = 0.0_prec ! Set v=0 - call this%solution%UpdateDevice() - call this%CalculateTendency() - call this%dSdt%UpdateHost() - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - iel=1:this%mesh%nElem) - - dpdx = -this%dSdt%interior(i,j,iel,1) - dpdy = -this%dSdt%interior(i,j,iel,2) - f = this%fCori%interior(i,j,iel,1) - this%solution%interior(i,j,iel,1) = -dpdy/f ! u - this%solution%interior(i,j,iel,2) = dpdx/f ! v - enddo - - call this%solution%UpdateDevice() - - endsubroutine DiagnoseGeostrophicVelocity_LinearShallowWater2D_t - - subroutine SetMetadata_LinearShallowWater2D_t(this) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - - call this%solution%SetName(1,"u") - call this%solution%SetUnits(1,"m/s") - call this%solution%SetName(2,"v") - call this%solution%SetUnits(2,"m/s") - call this%solution%SetName(3,"eta") - call this%solution%SetUnits(3,"m") - call this%fCori%SetName(1,"f") - call this%fCori%SetUnits(1,"1/s") - - endsubroutine SetMetadata_LinearShallowWater2D_t - - pure function entropy_func_LinearShallowWater2D_t(this,s) result(e) - class(LinearShallowWater2D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec) :: e - - e = 0.5_prec*(this%H*s(1)*s(1)+ & - this%H*s(2)*s(2)+ & - this%g*s(3)*s(3)) - - endfunction entropy_func_LinearShallowWater2D_t - - pure function flux2d_LinearShallowWater2D_t(this,s,dsdx) result(flux) - class(LinearShallowWater2D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar,1:2) - real(prec) :: flux(1:this%solution%nvar,1:2) - - flux(1,1) = this%g*s(3) - flux(1,2) = 0.0_prec - flux(2,1) = 0.0_prec - flux(2,2) = this%g*s(3) - flux(3,1) = this%H*s(1) - flux(3,2) = this%H*s(2) - - endfunction flux2d_LinearShallowWater2D_t - - pure function riemannflux2d_LinearShallowWater2D_t(this,sL,sR,dsdx,nhat) result(flux) - class(LinearShallowWater2D_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%solution%nVar) - real(prec),intent(in) :: sR(1:this%solution%nVar) - real(prec),intent(in) :: dsdx(1:this%solution%nVar,1:2) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: flux(1:this%solution%nVar) - ! Local - real(prec) :: c - real(prec) :: unL - real(prec) :: unR - - c = sqrt(this%g*this%H) - - unL = sL(1)*nhat(1)+sL(2)*nhat(2) - unR = sR(1)*nhat(1)+sR(2)*nhat(2) - - flux(1) = 0.5_prec*(this%g*(sL(3)+sR(3))+c*(unL-unR))*nhat(1) - flux(2) = 0.5_prec*(this%g*(sL(3)+sR(3))+c*(unL-unR))*nhat(2) - flux(3) = 0.5_prec*(this%H*(unL+unR)+c*(sL(3)-sR(3))) - - endfunction riemannflux2d_LinearShallowWater2D_t - - pure function hbc2d_NoNormalFlow_LinearShallowWater2D_t(this,s,nhat) result(exts) - class(LinearShallowWater2D_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - exts(1) = (nhat(2)**2-nhat(1)**2)*s(1)-2.0_prec*nhat(1)*nhat(2)*s(2) ! u - exts(2) = (nhat(1)**2-nhat(2)**2)*s(2)-2.0_prec*nhat(1)*nhat(2)*s(1) ! v - exts(3) = s(3) ! eta - - endfunction hbc2d_NoNormalFlow_LinearShallowWater2D_t - - subroutine sourcemethod_LinearShallowWater2D_t(this) - implicit none - class(LinearShallowWater2D_t),intent(inout) :: this - ! Local - integer :: iel - integer :: i - integer :: j - real(prec) :: s(1:this%nvar) - - do concurrent(i=1:this%solution%N+1,j=1:this%solution%N+1, & - iel=1:this%mesh%nElem) - - s = this%solution%interior(i,j,iel,1:this%nvar) - - this%source%interior(i,j,iel,1) = this%fCori%interior(i,j,iel,1)*s(2)-this%Cd*s(1) ! du/dt = f*v - Cd*u - this%source%interior(i,j,iel,2) = -this%fCori%interior(i,j,iel,1)*s(1)-this%Cd*s(2) ! dv/dt = -f*u - Cd*v - - enddo - - endsubroutine sourcemethod_LinearShallowWater2D_t - -endmodule self_LinearShallowWater2D_t diff --git a/src/SELF_Mesh.f90 b/src/SELF_Mesh.f90 index 5683e7597..a45d3a1f6 100644 --- a/src/SELF_Mesh.f90 +++ b/src/SELF_Mesh.f90 @@ -29,10 +29,11 @@ module SELF_Mesh use SELF_Constants use SELF_DomainDecomposition use iso_c_binding + use SELF_BoundaryConditions implicit none - type :: SEMMesh + type,abstract :: SEMMesh integer :: nGeo integer :: nElem integer :: nGlobalElem @@ -44,8 +45,31 @@ module SELF_Mesh integer :: nBCs integer :: quadrature type(DomainDecomposition) :: decomp + type(BoundaryConditionList) :: stateBCs + type(BoundaryConditionList) :: gradientBCs + + contains + procedure(SELF_FreeMesh),deferred :: Free + procedure(SELF_EnumerateBoundaryConditions),deferred :: EnumerateBoundaryConditions + endtype SEMMesh + interface + subroutine SELF_FreeMesh(this) + import SEMMesh + implicit none + class(SEMMesh),intent(inout) :: this + endsubroutine SELF_FreeMesh + endinterface + + interface + subroutine SELF_EnumerateBoundaryConditions(this) + import SEMMesh + implicit none + class(SEMMesh),intent(inout) :: this + endsubroutine SELF_EnumerateBoundaryConditions + endinterface + ! Element Types - From Table 4.1 of https://www.hopr-project.org/externals/Meshformat.pdf integer,parameter :: selfLineLinear = 1 integer,parameter :: selfLineNonlinear = 2 @@ -76,17 +100,4 @@ module SELF_Mesh integer,parameter :: SELF_MESH_HOPR_2D = 3 integer,parameter :: SELF_MESH_HOPR_3D = 4 -! //////////////////////////////////////////////// ! -! Boundary Condition parameters -! - - ! Conditions on the solution - integer,parameter :: SELF_BC_PRESCRIBED = 100 - integer,parameter :: SELF_BC_RADIATION = 101 - integer,parameter :: SELF_BC_NONORMALFLOW = 102 - - ! Conditions on the solution gradients - integer,parameter :: SELF_BC_PRESCRIBED_STRESS = 200 - integer,parameter :: SELF_BC_NOSTRESS = 201 - endmodule SELF_Mesh diff --git a/src/SELF_Mesh_1D.f90 b/src/SELF_Mesh_1D.f90 index b9708b0c8..c415c98d3 100644 --- a/src/SELF_Mesh_1D.f90 +++ b/src/SELF_Mesh_1D.f90 @@ -45,16 +45,12 @@ module SELF_Mesh_1D integer,pointer,dimension(:,:) :: elemInfo real(prec),pointer,dimension(:) :: nodeCoords integer,pointer,dimension(:) :: globalNodeIDs - integer,pointer,dimension(:,:) :: BCType - character(LEN=255),allocatable :: BCNames(:) - integer,dimension(2) :: bcid = 0 ! Boundary conditions for the left and right endpoints contains procedure,public :: Init => Init_Mesh1D procedure,public :: Free => Free_Mesh1D generic,public :: StructuredMesh => UniformBlockMesh_Mesh1D procedure,private :: UniformBlockMesh_Mesh1D - procedure,public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh1D procedure,public :: Write_Mesh => Write_Mesh1D @@ -77,13 +73,12 @@ subroutine Init_Mesh1D(this,nElem,nNodes,nBCs) this%nUniqueNodes = 0 this%nBCs = nBCs this%bcid = 0 - + call this%stateBCs%init() + call this%gradientBCs%init() allocate(this%elemInfo(1:4,1:nElem)) allocate(this%nodeCoords(1:nNodes)) allocate(this%globalNodeIDs(1:nNodes)) - allocate(this%BCType(1:4,1:nBCs)) - allocate(this%BCNames(1:nBCs)) call this%decomp%Init() endsubroutine Init_Mesh1D @@ -97,11 +92,11 @@ subroutine Free_Mesh1D(this) this%nCornerNodes = 0 this%nUniqueNodes = 0 this%nBCs = 0 + call this%stateBCs%free() + call this%gradientBCs%free() deallocate(this%elemInfo) deallocate(this%nodeCoords) deallocate(this%globalNodeIDs) - deallocate(this%BCType) - deallocate(this%BCNames) call this%decomp%Free() endsubroutine Free_Mesh1D @@ -166,21 +161,6 @@ subroutine UniformBlockMesh_Mesh1D(this,nElem,x) endsubroutine UniformBlockMesh_Mesh1D - subroutine ResetBoundaryConditionType_Mesh1D(this,leftbc,rightbc) - !! This method can be used to reset all of the boundary elements - !! boundary condition type to the desired value. - !! - !! Note that ALL physical boundaries will be set to have this boundary - !! condition - implicit none - class(Mesh1D),intent(inout) :: this - integer,intent(in) ::leftbc,rightbc - - this%bcid(1) = leftbc - this%bcid(2) = rightbc - - endsubroutine ResetBoundaryConditionType_Mesh1D - subroutine Write_Mesh1D(this,meshFile) ! Writes mesh output in HOPR format (serial IO only) implicit none @@ -195,7 +175,7 @@ subroutine Write_Mesh1D(this,meshFile) call WriteAttribute_HDF5(fileId,'Ngeo',this%nGeo) call WriteAttribute_HDF5(fileId,'nBCs',this%nBCs) - call WriteArray_HDF5(fileId,'BCType',this%bcType) + !call WriteArray_HDF5(fileId,'BCType',this%bcType) ! Read local subarray of ElemInfo call WriteArray_HDF5(fileId,'ElemInfo',this%elemInfo) diff --git a/src/SELF_Mesh_2D_t.f90 b/src/SELF_Mesh_2D_t.f90 index b1ea9c4a2..1510996e3 100644 --- a/src/SELF_Mesh_2D_t.f90 +++ b/src/SELF_Mesh_2D_t.f90 @@ -103,7 +103,6 @@ module SELF_Mesh_2D_t integer,pointer,dimension(:,:) :: CGNSCornerMap integer,pointer,dimension(:,:) :: CGNSSideMap integer,pointer,dimension(:,:) :: BCType - character(LEN=255),allocatable :: BCNames(:) contains procedure,public :: Init => Init_Mesh2D_t @@ -113,6 +112,7 @@ module SELF_Mesh_2D_t generic,public :: StructuredMesh => UniformStructuredMesh_Mesh2D_t procedure,private :: UniformStructuredMesh_Mesh2D_t procedure,public :: ResetBoundaryConditionType => ResetBoundaryConditionType_Mesh2D_t + procedure,public :: RegisterBoundaryCondition => RegisterBoundaryCondition_Mesh2D_t procedure,public :: Read_HOPr => Read_HOPr_Mesh2D_t @@ -153,8 +153,6 @@ subroutine Init_Mesh2D_t(this,nGeo,nElem,nSides,nNodes,nBCs) allocate(this%CGNSSideMap(1:2,1:4)) allocate(this%BCType(1:4,1:nBCs)) - allocate(this%BCNames(1:nBCs)) - ! Create lookup tables to assist with connectivity generation this%CGNSCornerMap(1:2,1) = (/1,1/) this%CGNSCornerMap(1:2,2) = (/nGeo+1,1/) @@ -188,7 +186,6 @@ subroutine Free_Mesh2D_t(this) deallocate(this%CGNSCornerMap) deallocate(this%CGNSSideMap) deallocate(this%BCType) - deallocate(this%BCNames) call this%decomp%Free() endsubroutine Free_Mesh2D_t @@ -484,7 +481,6 @@ subroutine Read_HOPr_Mesh2D_t(this,meshFile) integer,dimension(:,:),allocatable :: hopr_sideInfo real(prec),dimension(:,:),allocatable :: hopr_nodeCoords integer,dimension(:),allocatable :: hopr_globalNodeIDs - integer,dimension(:,:),allocatable :: bcType call this%decomp%init() @@ -505,16 +501,6 @@ subroutine Read_HOPr_Mesh2D_t(this,meshFile) print*,__FILE__//' : N Boundary conditions = ',nBCs print*,__FILE__//' : N Unique Sides (3D) = ',nUniqueSides3D - ! Read BCType - allocate(bcType(1:4,1:nBCS)) - - if(this%decomp%mpiEnabled) then - offset(:) = 0 - call ReadArray_HDF5(fileId,'BCType',bcType,offset) - else - call ReadArray_HDF5(fileId,'BCType',bcType) - endif - ! Read local subarray of ElemInfo print*,__FILE__//' : Generating Domain Decomposition' call this%decomp%GenerateDecomposition(nGlobalElem,nUniqueSides3D) @@ -578,6 +564,12 @@ subroutine Read_HOPr_Mesh2D_t(this,meshFile) print*,__FILE__//' : Rank ',this%decomp%rankId+1,' Allocating memory for mesh' print*,__FILE__//' : Rank ',this%decomp%rankId+1,' n local sides : ',nLocalSides2D call this%Init(nGeo,nLocalElems,nLocalSides2D,nLocalNodes2D,nBCs) + if(this%decomp%mpiEnabled) then + offset(:) = 0 + call ReadArray_HDF5(fileId,'BCType',this%bcType,offset) + else + call ReadArray_HDF5(fileId,'BCType',this%bcType) + endif this%nUniqueSides = nUniqueSides2D ! Store the number of sides in the global mesh ! Copy data from local arrays into this @@ -627,6 +619,53 @@ subroutine Read_HOPr_Mesh2D_t(this,meshFile) endsubroutine Read_HOPr_Mesh2D_t + subroutine RegisterBoundaryCondition_Mesh2D_t(mesh,bcid,bcname,bcfunc) + implicit none + class(Mesh2D_t),intent(inout) :: mesh + integer,intent(in) :: bcid + character(*),intent(in) :: bcname + procedure(SELF_bcMethod),pointer,intent(in) :: bcfunc + ! Local + integer :: iel,j + integer :: e2,localbcid,nsides + type(BoundaryCondition),pointer :: bc + + nsides = 0 + do iel = 1,mesh%nElem + do j = 1,4 + e2 = mesh%sideInfo(3,j,iel) ! Neighboring Element ID + localbcid = mesh%sideInfo(5,j,iel) ! Boundary Condition ID + if(e2 == 0 .and. localbcid == bcid) then + nsides = nsides+1 + endif + enddo + enddo + + if(nsides == 0) then + print*,"(RegisterBoundaryCondition) : WARNING : No sides found with BC ID ",bcid + else + print*,"(RegisterBoundaryCondition) : INFO : Registering BC ID ",bcid," named '",trim(bcname),"' with ",nsides," sides." + call mesh%stateBCs%RegisterBoundaryCondition(bcid,bcname,bcfunc,nsides) + endif + + ! Now, we capture the list of elements and local sides for this boundary condition + nsides = 0 + bc => this%stateBCs%GetBCForID(bcid) + do iel = 1,mesh%nElem + do j = 1,4 + e2 = mesh%sideInfo(3,j,iel) ! Neighboring Element ID + ! See comment from https://hopr.readthedocs.io/en/latest/userguide/meshformat.html#side-information-sideinfo + localbcid = mesh%sideInfo(5,j,iel) ! Boundary Condition ID ! TO DO: Verify that we don't need to get mesh%bctype(bcid) + if(e2 == 0 .and. localbcid == bcid) then + nsides = nsides+1 + bc%elements(nsides) = iel + bc%sides(nsides) = j + endif + enddo + enddo + + endsubroutine RegisterBoundaryCondition_Mesh2D_t + subroutine RecalculateFlip_Mesh2D_t(this) implicit none class(Mesh2D_t),intent(inout) :: this diff --git a/src/SELF_Model.f90 b/src/SELF_Model.f90 index 76c10abfb..ad397ba1e 100644 --- a/src/SELF_Model.f90 +++ b/src/SELF_Model.f90 @@ -31,6 +31,7 @@ module SELF_Model use SELF_HDF5 use HDF5 use FEQParse + use SELF_BoundaryConditions #include "SELF_Macros.h" @@ -107,11 +108,14 @@ module SELF_Model logical :: prescribed_bcs_enabled = .true. logical :: tecplot_enabled = .true. integer :: nvar + integer :: ndim ! Standard Diagnostics real(prec) :: entropy ! Mathematical entropy function for the model contains + procedure(SELF_FreeModel),deferred :: Free + procedure :: IncrementIOCounter procedure :: PrintType => PrintType_Model @@ -151,28 +155,6 @@ module SELF_Model procedure :: source2d => source2d_Model procedure :: source3d => source3d_Model - ! Boundary condition functions (hyperbolic) - procedure :: hbc1d_Prescribed => hbc1d_Prescribed_Model - procedure :: hbc1d_Radiation => hbc1d_Generic_Model - procedure :: hbc1d_NoNormalFlow => hbc1d_Generic_Model - procedure :: hbc2d_Prescribed => hbc2d_Prescribed_Model - procedure :: hbc2d_Radiation => hbc2d_Generic_Model - procedure :: hbc2d_NoNormalFlow => hbc2d_Generic_Model - procedure :: hbc3d_Prescribed => hbc3d_Prescribed_Model - procedure :: hbc3d_Radiation => hbc3d_Generic_Model - procedure :: hbc3d_NoNormalFlow => hbc3d_Generic_Model - - ! Boundary condition functions (parabolic) - procedure :: pbc1d_Prescribed => pbc1d_Prescribed_Model - procedure :: pbc1d_Radiation => pbc1d_Generic_Model - procedure :: pbc1d_NoNormalFlow => pbc1d_Generic_Model - procedure :: pbc2d_Prescribed => pbc2d_Prescribed_Model - procedure :: pbc2d_Radiation => pbc2d_Generic_Model - procedure :: pbc2d_NoNormalFlow => pbc2d_Generic_Model - procedure :: pbc3d_Prescribed => pbc3d_Prescribed_Model - procedure :: pbc3d_Radiation => pbc3d_Generic_Model - procedure :: pbc3d_NoNormalFlow => pbc3d_Generic_Model - procedure :: ReportEntropy => ReportEntropy_Model procedure :: ReportMetrics => ReportMetrics_Model procedure :: ReportUserMetrics => ReportUserMetrics_Model @@ -192,6 +174,14 @@ module SELF_Model endtype Model + interface + subroutine SELF_FreeModel(this) + import Model + implicit none + class(Model),intent(inout) :: this + endsubroutine SELF_FreeModel + endinterface + interface subroutine SELF_timeIntegrator(this,tn) use SELF_Constants,only:prec @@ -258,6 +248,10 @@ subroutine WriteTecplot(this,filename) contains +! //////////////////////////////////////////// ! +! Model Methods +! ////////////////////////////////////////////// ! + subroutine IncrementIOCounter(this) implicit none class(Model),intent(inout) :: this @@ -458,174 +452,6 @@ pure function source3d_Model(this,s,dsdx) result(source) endfunction source3d_Model - pure function hbc1d_Generic_Model(this,s,nhat) result(exts) - class(Model),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: nhat - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo - - endfunction hbc1d_Generic_Model - - pure function hbc1d_Prescribed_Model(this,x,t) result(exts) - class(Model),intent(in) :: this - real(prec),intent(in) :: x - real(prec),intent(in) :: t - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo - - endfunction hbc1d_Prescribed_Model - - pure function hbc2d_Generic_Model(this,s,nhat) result(exts) - class(Model),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo - - endfunction hbc2d_Generic_Model - - pure function hbc2d_Prescribed_Model(this,x,t) result(exts) - class(Model),intent(in) :: this - real(prec),intent(in) :: x(1:2) - real(prec),intent(in) :: t - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo - - endfunction hbc2d_Prescribed_Model - - pure function hbc3d_Generic_Model(this,s,nhat) result(exts) - class(Model),intent(in) :: this - real(prec),intent(in) :: s(1:this%nvar) - real(prec),intent(in) :: nhat(1:3) - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo - - endfunction hbc3d_Generic_Model - - pure function hbc3d_Prescribed_Model(this,x,t) result(exts) - class(Model),intent(in) :: this - real(prec),intent(in) :: x(1:3) - real(prec),intent(in) :: t - real(prec) :: exts(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - exts(ivar) = 0.0_prec - enddo - - endfunction hbc3d_Prescribed_Model - - pure function pbc1d_Generic_Model(this,dsdx,nhat) result(extDsdx) - class(Model),intent(in) :: this - real(prec),intent(in) :: dsdx(1:this%nvar) - real(prec),intent(in) :: nhat - real(prec) :: extDsdx(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - extDsdx(ivar) = dsdx(ivar) - enddo - - endfunction pbc1d_Generic_Model - - pure function pbc1d_Prescribed_Model(this,x,t) result(extDsdx) - class(Model),intent(in) :: this - real(prec),intent(in) :: x - real(prec),intent(in) :: t - real(prec) :: extDsdx(1:this%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - extDsdx(ivar) = 0.0_prec - enddo - - endfunction pbc1d_Prescribed_Model - - pure function pbc2d_Generic_Model(this,dsdx,nhat) result(extDsdx) - class(Model),intent(in) :: this - real(prec),intent(in) :: dsdx(1:this%nvar,1:2) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: extDsdx(1:this%nvar,1:2) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - extDsdx(ivar,1:2) = dsdx(ivar,1:2) - enddo - - endfunction pbc2d_Generic_Model - - pure function pbc2d_Prescribed_Model(this,x,t) result(extDsdx) - class(Model),intent(in) :: this - real(prec),intent(in) :: x(1:2) - real(prec),intent(in) :: t - real(prec) :: extDsdx(1:this%nvar,1:2) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - extDsdx(ivar,1:2) = 0.0_prec - enddo - - endfunction pbc2d_Prescribed_Model - - pure function pbc3d_Generic_Model(this,dsdx,nhat) result(extDsdx) - class(Model),intent(in) :: this - real(prec),intent(in) :: dsdx(1:this%nvar,1:3) - real(prec),intent(in) :: nhat(1:3) - real(prec) :: extDsdx(1:this%nvar,1:3) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - extDsdx(ivar,1:3) = dsdx(ivar,1:3) - enddo - - endfunction pbc3d_Generic_Model - - pure function pbc3d_Prescribed_Model(this,x,t) result(extDsdx) - class(Model),intent(in) :: this - real(prec),intent(in) :: x(1:3) - real(prec),intent(in) :: t - real(prec) :: extDsdx(1:this%nvar,1:3) - ! Local - integer :: ivar - - do ivar = 1,this%nvar - extDsdx(ivar,1:3) = 0.0_prec - enddo - - endfunction pbc3d_Prescribed_Model - subroutine SetTimeIntegrator_withChar(this,integrator) !! Sets the time integrator method, using a character input !! diff --git a/src/SELF_advection_diffusion_1d_t.f90 b/src/SELF_advection_diffusion_1d_t.f90 deleted file mode 100644 index 591f0a0ee..000000000 --- a/src/SELF_advection_diffusion_1d_t.f90 +++ /dev/null @@ -1,94 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUsLESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARIsLG IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_1d_t - - use self_model - use self_dgmodel1d - use self_mesh - - implicit none - - type,extends(dgmodel1d) :: advection_diffusion_1d_t - real(prec) :: nu ! diffusion coefficient - real(prec) :: u ! constant velocity - - contains - procedure :: riemannflux1d => riemannflux1d_advection_diffusion_1d_t - procedure :: flux1d => flux1d_advection_diffusion_1d_t - procedure :: entropy_func => entropy_func_advection_diffusion_1d_t - - endtype advection_diffusion_1d_t - -contains - - pure function entropy_func_advection_diffusion_1d_t(this,s) result(e) - class(advection_diffusion_1d_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec) :: e - ! Local - integer :: ivar - - e = 0.0_prec - do ivar = 1,this%solution%nvar - e = e+0.5_prec*s(ivar)*s(ivar) - enddo - - endfunction entropy_func_advection_diffusion_1d_t - - pure function riemannflux1d_advection_diffusion_1d_t(this,sL,sR,dsdx,nhat) result(flux) - class(advection_diffusion_1d_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%solution%nvar) - real(prec),intent(in) :: sR(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar) - real(prec),intent(in) :: nhat - real(prec) :: flux(1:this%solution%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%solution%nvar - flux(ivar) = 0.5_prec*(this%u*nhat*(sL(ivar)+sR(ivar))+ & - abs(this%u*nhat)*(sL(ivar)-sR(ivar)))- & ! advective flux - this%nu*dsdx(ivar)*nhat ! diffusive flux - enddo - - endfunction riemannflux1d_advection_diffusion_1d_t - - pure function flux1d_advection_diffusion_1d_t(this,s,dsdx) result(flux) - class(advection_diffusion_1d_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar) - real(prec) :: flux(1:this%solution%nvar) - ! Local - integer :: ivar - - do ivar = 1,this%solution%nvar - flux(ivar) = this%u*s(ivar)-this%nu*dsdx(ivar) ! advective flux + diffusive flux - enddo - - endfunction flux1d_advection_diffusion_1d_t - -endmodule self_advection_diffusion_1d_t diff --git a/src/SELF_advection_diffusion_2d_t.f90 b/src/SELF_advection_diffusion_2d_t.f90 deleted file mode 100644 index 596dff4be..000000000 --- a/src/SELF_advection_diffusion_2d_t.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_2d_t - - use self_dgmodel2d - use self_mesh - - implicit none - - type,extends(dgmodel2d) :: advection_diffusion_2d_t - real(prec) :: nu ! diffusion coefficient - real(prec) :: u ! constant x-component of velocity - real(prec) :: v ! constant y-component of velocity - - contains - procedure :: riemannflux2d => riemannflux2d_advection_diffusion_2d_t - procedure :: flux2d => flux2d_advection_diffusion_2d_t - procedure :: entropy_func => entropy_func_advection_diffusion_2d_t - - endtype advection_diffusion_2d_t - -contains - - pure function entropy_func_advection_diffusion_2d_t(this,s) result(e) - class(advection_diffusion_2d_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec) :: e - ! Local - integer :: ivar - - e = 0.0_prec - do ivar = 1,this%solution%nvar - e = e+0.5_prec*s(ivar)*s(ivar) - enddo - - endfunction entropy_func_advection_diffusion_2d_t - - pure function flux2d_advection_diffusion_2d_t(this,s,dsdx) result(flux) - class(advection_diffusion_2d_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar,1:2) - real(prec) :: flux(1:this%solution%nvar,1:2) - ! Local - integer :: ivar - - do ivar = 1,this%solution%nvar - flux(ivar,1) = this%u*s(ivar)-this%nu*dsdx(ivar,1) ! advective flux + diffusive flux - flux(ivar,2) = this%v*s(ivar)-this%nu*dsdx(ivar,2) ! advective flux + diffusive flux - enddo - - endfunction flux2d_advection_diffusion_2d_t - - pure function riemannflux2d_advection_diffusion_2d_t(this,sL,sR,dsdx,nhat) result(flux) - class(advection_diffusion_2d_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%nvar) - real(prec),intent(in) :: sR(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:2) - real(prec),intent(in) :: nhat(1:2) - real(prec) :: flux(1:this%nvar) - ! Local - integer :: ivar - real(prec) :: un,dsdn - - un = this%u*nhat(1)+this%v*nhat(2) - - do ivar = 1,this%nvar - dsdn = dsdx(ivar,1)*nhat(1)+dsdx(ivar,2)*nhat(2) - flux(ivar) = 0.5_prec*( & - (sL(ivar)+sR(ivar))+abs(un)*(sL(ivar)-sR(ivar)))- & ! advective flux - this%nu*dsdn - enddo - - endfunction riemannflux2d_advection_diffusion_2d_t - -endmodule self_advection_diffusion_2d_t diff --git a/src/SELF_advection_diffusion_3d_t.f90 b/src/SELF_advection_diffusion_3d_t.f90 deleted file mode 100644 index 92dd69244..000000000 --- a/src/SELF_advection_diffusion_3d_t.f90 +++ /dev/null @@ -1,103 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_3d_t - - use self_model - use self_dgmodel3d - use self_mesh - - implicit none - - type,extends(dgmodel3d) :: advection_diffusion_3d_t - real(prec) :: nu ! diffusion coefficient - real(prec) :: u ! constant x-component of velocity - real(prec) :: v ! constant y-component of velocity - real(prec) :: w ! constant z-component of velocity - - contains - - procedure :: riemannflux3d => riemannflux3d_advection_diffusion_3d_t - procedure :: flux3d => flux3d_advection_diffusion_3d_t - procedure :: entropy_func => entropy_func_advection_diffusion_3d_t - - endtype advection_diffusion_3d_t - -contains - - pure function entropy_func_advection_diffusion_3d_t(this,s) result(e) - class(advection_diffusion_3d_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec) :: e -! Local - integer :: ivar - - e = 0.0_prec - do ivar = 1,this%solution%nvar - e = e+0.5_prec*s(ivar)*s(ivar) - enddo - - endfunction entropy_func_advection_diffusion_3d_t - - pure function flux3d_advection_diffusion_3d_t(this,s,dsdx) result(flux) - class(advection_diffusion_3d_t),intent(in) :: this - real(prec),intent(in) :: s(1:this%solution%nvar) - real(prec),intent(in) :: dsdx(1:this%solution%nvar,1:3) - real(prec) :: flux(1:this%solution%nvar,1:3) -! Local - integer :: ivar - - do ivar = 1,this%solution%nvar - flux(ivar,1) = this%u*s(ivar)-this%nu*dsdx(ivar,1) ! advective flux + diffusive flux - flux(ivar,2) = this%v*s(ivar)-this%nu*dsdx(ivar,2) ! advective flux + diffusive flux - flux(ivar,3) = this%w*s(ivar)-this%nu*dsdx(ivar,3) ! advective flux + diffusive flux - enddo - - endfunction flux3d_advection_diffusion_3d_t - - pure function riemannflux3d_advection_diffusion_3d_t(this,sL,sR,dsdx,nhat) result(flux) - class(advection_diffusion_3d_t),intent(in) :: this - real(prec),intent(in) :: sL(1:this%nvar) - real(prec),intent(in) :: sR(1:this%nvar) - real(prec),intent(in) :: dsdx(1:this%nvar,1:3) - real(prec),intent(in) :: nhat(1:3) - real(prec) :: flux(1:this%nvar) -! Local - integer :: ivar - real(prec) :: un,dsdn - - un = this%u*nhat(1)+this%v*nhat(2)+this%w*nhat(3) - - do ivar = 1,this%nvar - dsdn = dsdx(ivar,1)*nhat(1)+dsdx(ivar,2)*nhat(2)+dsdx(ivar,3)*nhat(3) - flux(ivar) = 0.5_prec*( & - (sL(ivar)+sR(ivar))+abs(un)*(sL(ivar)-sR(ivar)))- & ! advective flux - this%nu*dsdn - enddo - - endfunction riemannflux3d_advection_diffusion_3d_t - -endmodule self_advection_diffusion_3d_t diff --git a/src/cpu/SELF_Burgers1D.f90 b/src/cpu/SELF_Burgers1D.f90 deleted file mode 100644 index 569e88e43..000000000 --- a/src/cpu/SELF_Burgers1D.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_Burgers1D - - use self_Burgers1D_t - - implicit none - - type,extends(Burgers1D_t) :: Burgers1D - endtype Burgers1D - -endmodule self_Burgers1D diff --git a/src/cpu/SELF_LinearEuler2D.f90 b/src/cpu/SELF_LinearEuler2D.f90 deleted file mode 100644 index a69ae688d..000000000 --- a/src/cpu/SELF_LinearEuler2D.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearEuler2D - - use self_LinearEuler2D_t - - implicit none - - type,extends(LinearEuler2D_t) :: LinearEuler2D - endtype LinearEuler2D - -endmodule self_LinearEuler2D diff --git a/src/cpu/SELF_LinearEuler3D.f90 b/src/cpu/SELF_LinearEuler3D.f90 deleted file mode 100644 index 62102d1f2..000000000 --- a/src/cpu/SELF_LinearEuler3D.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearEuler3D - - use self_LinearEuler3D_t - - implicit none - - type,extends(LinearEuler3D_t) :: LinearEuler3D - endtype LinearEuler3D - -endmodule self_LinearEuler3D diff --git a/src/cpu/SELF_LinearShallowWater2D.f90 b/src/cpu/SELF_LinearShallowWater2D.f90 deleted file mode 100644 index 0203318e0..000000000 --- a/src/cpu/SELF_LinearShallowWater2D.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearShallowWater2D - - use self_LinearShallowWater2D_t - - implicit none - - type,extends(LinearShallowWater2D_t) :: LinearShallowWater2D - endtype LinearShallowWater2D - -endmodule self_LinearShallowWater2D diff --git a/src/cpu/SELF_advection_diffusion_1d.f90 b/src/cpu/SELF_advection_diffusion_1d.f90 deleted file mode 100644 index 0500ac4e4..000000000 --- a/src/cpu/SELF_advection_diffusion_1d.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_1d - - use self_advection_diffusion_1d_t - - implicit none - - type,extends(advection_diffusion_1d_t) :: advection_diffusion_1d - endtype advection_diffusion_1d - -endmodule self_advection_diffusion_1d diff --git a/src/cpu/SELF_advection_diffusion_2d.f90 b/src/cpu/SELF_advection_diffusion_2d.f90 deleted file mode 100644 index 3d737b12b..000000000 --- a/src/cpu/SELF_advection_diffusion_2d.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_2d - - use self_advection_diffusion_2d_t - - implicit none - - type,extends(advection_diffusion_2d_t) :: advection_diffusion_2d - endtype advection_diffusion_2d - -endmodule self_advection_diffusion_2d diff --git a/src/cpu/SELF_advection_diffusion_3d.f90 b/src/cpu/SELF_advection_diffusion_3d.f90 deleted file mode 100644 index 158a4f29c..000000000 --- a/src/cpu/SELF_advection_diffusion_3d.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_3d - - use self_advection_diffusion_3d_t - - implicit none - - type,extends(advection_diffusion_3d_t) :: advection_diffusion_3d - endtype advection_diffusion_3d - -endmodule self_advection_diffusion_3d diff --git a/src/gpu/SELF_Burgers1D.f90 b/src/gpu/SELF_Burgers1D.f90 deleted file mode 100644 index 569e88e43..000000000 --- a/src/gpu/SELF_Burgers1D.f90 +++ /dev/null @@ -1,36 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_Burgers1D - - use self_Burgers1D_t - - implicit none - - type,extends(Burgers1D_t) :: Burgers1D - endtype Burgers1D - -endmodule self_Burgers1D diff --git a/src/gpu/SELF_DGModel1D.f90 b/src/gpu/SELF_DGModel1D.f90 index 55d42de39..6bb99c2c6 100644 --- a/src/gpu/SELF_DGModel1D.f90 +++ b/src/gpu/SELF_DGModel1D.f90 @@ -179,62 +179,12 @@ subroutine setboundarycondition_DGModel1D(this) ! on the gradient field implicit none class(DGModel1D),intent(inout) :: this - ! local - integer :: ivar - integer :: N,nelem - real(prec) :: x call gpuCheck(hipMemcpy(c_loc(this%solution%boundary), & this%solution%boundary_gpu,sizeof(this%solution%boundary), & hipMemcpyDeviceToHost)) - nelem = this%geometry%nelem ! number of elements in the mesh - N = this%solution%interp%N ! polynomial degree - ! left-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(1,1,1) - this%solution%extBoundary(1,1,1:this%nvar) = & - this%hbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solution%extBoundary(1,1,1:this%nvar) = & - this%hbc1d_Radiation(this%solution%boundary(1,1,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solution%extBoundary(1,1,1:this%nvar) = & - this%hbc1d_NoNormalFlow(this%solution%boundary(1,1,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solution%extBoundary(1,1,1:this%nvar) = this%solution%boundary(2,nelem,1:this%nvar) - - endif - - ! right-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(2,nelem,1) - this%solution%extBoundary(2,nelem,1:this%nvar) = & - this%hbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solution%extBoundary(2,nelem,1:this%nvar) = & - this%hbc1d_Radiation(this%solution%boundary(2,nelem,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solution%extBoundary(2,nelem,1:this%nvar) = & - this%hbc1d_NoNormalFlow(this%solution%boundary(2,nelem,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solution%extBoundary(2,nelem,1:this%nvar) = this%solution%boundary(1,1,1:this%nvar) - - endif + call setboundarycondition_DGModel1D_t(this) call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & c_loc(this%solution%extBoundary), & @@ -251,62 +201,12 @@ subroutine setgradientboundarycondition_DGModel1D(this) ! Here, we use periodic boundary conditions implicit none class(DGModel1D),intent(inout) :: this - ! local - integer :: ivar - integer :: nelem - real(prec) :: x call gpuCheck(hipMemcpy(c_loc(this%solutiongradient%boundary), & this%solutiongradient%boundary_gpu,sizeof(this%solutiongradient%boundary), & hipMemcpyDeviceToHost)) - nelem = this%geometry%nelem ! number of elements in the mesh - - ! left-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(1,1,1) - this%solutionGradient%extBoundary(1,1,1:this%nvar) = & - this%pbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solutionGradient%extBoundary(1,1,1:this%nvar) = & - this%pbc1d_Radiation(this%solutionGradient%boundary(1,1,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solutionGradient%extBoundary(1,1,1:this%nvar) = & - this%pbc1d_NoNormalFlow(this%solutionGradient%boundary(1,1,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solutionGradient%extBoundary(1,1,1:this%nvar) = this%solutionGradient%boundary(2,nelem,1:this%nvar) - - endif - - ! right-most boundary - if(this%mesh%bcid(1) == SELF_BC_PRESCRIBED) then - - x = this%geometry%x%boundary(2,nelem,1) - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = & - this%pbc1d_Prescribed(x,this%t) - - elseif(this%mesh%bcid(1) == SELF_BC_RADIATION) then - - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = & - this%pbc1d_Radiation(this%solutionGradient%boundary(2,nelem,1:this%nvar),-1.0_prec) - - elseif(this%mesh%bcid(1) == SELF_BC_NONORMALFLOW) then - - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = & - this%pbc1d_NoNormalFlow(this%solutionGradient%boundary(2,nelem,1:this%nvar),-1.0_prec) - - else ! Periodic - - this%solutionGradient%extBoundary(2,nelem,1:this%nvar) = this%solutionGradient%boundary(1,1,1:this%nvar) - - endif + call setgradientboundarycondition_DGModel1D_t(this) call gpuCheck(hipMemcpy(this%solutiongradient%extBoundary_gpu, & c_loc(this%solutiongradient%extBoundary), & diff --git a/src/gpu/SELF_DGModel2D.f90 b/src/gpu/SELF_DGModel2D.f90 index 0d5c00042..f0742ac98 100644 --- a/src/gpu/SELF_DGModel2D.f90 +++ b/src/gpu/SELF_DGModel2D.f90 @@ -296,9 +296,6 @@ subroutine setboundarycondition_DGModel2D(this) !! boundary conditions. implicit none class(DGModel2D),intent(inout) :: this - ! local - integer :: i,iEl,j,e2,bcid - real(prec) :: nhat(1:2),x(1:2) call gpuCheck(hipMemcpy(c_loc(this%solution%boundary), & this%solution%boundary_gpu,sizeof(this%solution%boundary), & @@ -308,43 +305,7 @@ subroutine setboundarycondition_DGModel2D(this) this%solution%extboundary_gpu,sizeof(this%solution%extboundary), & hipMemcpyDeviceToHost)) - do concurrent(j=1:4,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,iEl,1,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_Prescribed(x,this%t) - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_Radiation(this%solution%boundary(i,j,iEl,1:this%nvar),nhat) - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_NoNormalFlow(this%solution%boundary(i,j,iEl,1:this%nvar),nhat) - enddo - - endif - endif - - enddo + call setboundarycondition_DGModel2D_t(this) call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & c_loc(this%solution%extBoundary), & @@ -359,10 +320,6 @@ subroutine setgradientboundarycondition_DGModel2D(this) !! boundary conditions. implicit none class(DGModel2D),intent(inout) :: this - ! local - integer :: i,iEl,j,e2,bcid - real(prec) :: dsdx(1:this%nvar,1:2) - real(prec) :: nhat(1:2),x(1:2) call gpuCheck(hipMemcpy(c_loc(this%solutiongradient%boundary), & this%solutiongradient%boundary_gpu,sizeof(this%solutiongradient%boundary), & @@ -372,47 +329,7 @@ subroutine setgradientboundarycondition_DGModel2D(this) this%solutiongradient%extboundary_gpu,sizeof(this%solutiongradient%extboundary), & hipMemcpyDeviceToHost)) - do concurrent(j=1:4,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,iEl,1,1:2) - - this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & - this%pbc2d_Prescribed(x,this%t) - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - - dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) - - this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & - this%pbc2d_Radiation(dsdx,nhat) - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,iEl,1,1:2) - - dsdx = this%solutiongradient%boundary(i,j,iEl,1:this%nvar,1:2) - - this%solutiongradient%extBoundary(i,j,iEl,1:this%nvar,1:2) = & - this%pbc2d_NoNormalFlow(dsdx,nhat) - enddo - - endif - endif - - enddo + call setgradientboundarycondition_DGModel2D_t(this) call gpuCheck(hipMemcpy(this%solutiongradient%extBoundary_gpu, & c_loc(this%solutiongradient%extBoundary), & diff --git a/src/gpu/SELF_DGModel3D.f90 b/src/gpu/SELF_DGModel3D.f90 index 2fe9378f5..1b429a38e 100644 --- a/src/gpu/SELF_DGModel3D.f90 +++ b/src/gpu/SELF_DGModel3D.f90 @@ -296,9 +296,6 @@ subroutine setboundarycondition_DGModel3D(this) !! boundary conditions. implicit none class(DGModel3D),intent(inout) :: this - ! local - integer :: i,iEl,j,k,e2,bcid - real(prec) :: nhat(1:3),x(1:3) call gpuCheck(hipMemcpy(c_loc(this%solution%boundary), & this%solution%boundary_gpu,sizeof(this%solution%boundary), & @@ -308,49 +305,7 @@ subroutine setboundarycondition_DGModel3D(this) this%solution%extboundary_gpu,sizeof(this%solution%extboundary), & hipMemcpyDeviceToHost)) - do concurrent(k=1:6,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,k,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_Prescribed(x,this%t) - enddo - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_Radiation(this%solution%boundary(i,j,k,iEl,1:this%nvar),nhat) - enddo - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3d_NoNormalFlow(this%solution%boundary(i,j,k,iEl,1:this%nvar),nhat) - enddo - enddo - - endif - endif - - enddo + call setboundarycondition_DGModel3D_t(this) call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & c_loc(this%solution%extBoundary), & @@ -365,10 +320,6 @@ subroutine setgradientboundarycondition_DGModel3D(this) !! boundary conditions. implicit none class(DGModel3D),intent(inout) :: this - ! local - integer :: i,iEl,j,k,e2,bcid - real(prec) :: dsdx(1:this%nvar,1:3) - real(prec) :: nhat(1:3),x(1:3) call gpuCheck(hipMemcpy(c_loc(this%solutiongradient%boundary), & this%solutiongradient%boundary_gpu,sizeof(this%solutiongradient%boundary), & @@ -378,53 +329,7 @@ subroutine setgradientboundarycondition_DGModel3D(this) this%solutiongradient%extboundary_gpu,sizeof(this%solutiongradient%extboundary), & hipMemcpyDeviceToHost)) - do concurrent(k=1:6,iel=1:this%mesh%nElem) - - bcid = this%mesh%sideInfo(5,k,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,k,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do j = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - x = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & - this%pbc3d_Prescribed(x,this%t) - enddo - enddo - - elseif(bcid == SELF_BC_RADIATION) then - - do j = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) - - this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & - this%pbc3d_Radiation(dsdx,nhat) - enddo - enddo - - elseif(bcid == SELF_BC_NONORMALFLOW) then - - do j = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - do i = 1,this%solutiongradient%interp%N+1 ! Loop over quadrature points - nhat = this%geometry%nhat%boundary(i,j,k,iEl,1,1:3) - - dsdx = this%solutiongradient%boundary(i,j,k,iEl,1:this%nvar,1:3) - - this%solutiongradient%extBoundary(i,j,k,iEl,1:this%nvar,1:3) = & - this%pbc3d_NoNormalFlow(dsdx,nhat) - enddo - enddo - - endif - endif - - enddo + call setgradientboundarycondition_DGModel3D_t(this) call gpuCheck(hipMemcpy(this%solutiongradient%extBoundary_gpu, & c_loc(this%solutiongradient%extBoundary), & diff --git a/src/gpu/SELF_LinearEuler2D.cpp b/src/gpu/SELF_LinearEuler2D.cpp deleted file mode 100644 index 2880ab2e3..000000000 --- a/src/gpu/SELF_LinearEuler2D.cpp +++ /dev/null @@ -1,161 +0,0 @@ -/* -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -*/ - -#include "SELF_GPU_Macros.h" - - -__global__ void boundaryflux_LinearEuler2D_kernel(real *fb, real *extfb, real *nhat, real *nmag, real *flux, real rho0, real c, int ndof){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof ){ - - real fl[4]; - real nx = nhat[idof]; - real ny = nhat[idof+ndof]; - real un = fb[idof + ndof]*nx + fb[idof + 2*ndof]*ny; - real p = fb[idof + 3*ndof]; - - fl[0] = rho0*un; // density flux - fl[1] = p*nx/rho0; // x-momentum flux - fl[2] = p*ny/rho0; // y-momentum flux - fl[3] = rho0*c*c*un; // pressure flux - - real fr[4]; - un = extfb[idof + ndof]*nx + extfb[idof + 2*ndof]*ny; - p = extfb[idof + 3*ndof]; - - fr[0] = rho0*un; // density flux - fr[1] = p*nx/rho0; // x-momentum flux - fr[2] = p*ny/rho0; // y-momentum flux - fr[3] = rho0*c*c*un; // pressure flux - - real nm = nmag[idof]; - flux[idof] = (0.5*(fl[0]+fr[0])+c*(fb[idof]-extfb[idof]))*nm; // density - flux[idof+ndof] = (0.5*(fl[1]+fr[1])+c*(fb[idof+ndof]-extfb[idof+ndof]))*nm; // u - flux[idof+2*ndof] = (0.5*(fl[2]+fr[2])+c*(fb[idof+2*ndof]-extfb[idof+2*ndof]))*nm; // v - flux[idof+3*ndof] = (0.5*(fl[3]+fr[3])+c*(fb[idof+3*ndof]-extfb[idof+3*ndof]))*nm; // p - } -} - -extern "C" -{ - void boundaryflux_LinearEuler2D_gpu(real *fb, real *extfb,real *nhat, real *nmag, real *flux, real rho0, real c, int N, int nel, int nvar){ - int threads_per_block = 256; - uint32_t ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,1); - dim3 nthreads(threads_per_block,1,1); - - boundaryflux_LinearEuler2D_kernel<<>>(fb,extfb,nhat,nmag,flux,rho0,c,ndof); - } -} - - __global__ void fluxmethod_LinearEuler2D_gpukernel(real *solution, real *flux, real rho0, real c, int ndof, int nvar){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof ){ - real rho = solution[idof]; - real u = solution[idof + ndof]; - real v = solution[idof + 2*ndof]; - real p = solution[idof + 3*ndof]; - - flux[idof + ndof*(0 + nvar*0)] = rho0*u; // density, x flux ; rho0*u - flux[idof + ndof*(0 + nvar*1)] = rho0*v; // density, y flux ; rho0*v - - flux[idof + ndof*(1 + nvar*0)] = p/rho0; // x-velocity, x flux; p/rho0 - flux[idof + ndof*(1 + nvar*1)] = 0.0; // x-velocity, y flux; 0 - - flux[idof + ndof*(2 + nvar*0)] = 0.0; // y-velocity, x flux; 0 - flux[idof + ndof*(2 + nvar*1)] = p/rho0; // y-velocity, y flux; p/rho0 - - flux[idof + ndof*(3 + nvar*0)] = c*c*rho0*u; // pressure, x flux : rho0*c^2*u - flux[idof + ndof*(3 + nvar*1)] = c*c*rho0*v; // pressure, y flux : rho0*c^2*v - - } - -} -extern "C" -{ - void fluxmethod_LinearEuler2D_gpu(real *solution, real *flux, real rho0, real c, int N, int nel, int nvar){ - int ndof = (N+1)*(N+1)*nel; - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - fluxmethod_LinearEuler2D_gpukernel<<>>(solution,flux,rho0,c,ndof,nvar); - } - -} -__global__ void setboundarycondition_LinearEuler2D_gpukernel(real *extBoundary, real *boundary, int *sideInfo, real *nhat, int N, int nel, int nvar){ - - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*4*nel; - - if(idof < ndof){ - uint32_t i = idof % (N+1); - uint32_t s1 = (idof/(N+1)) % 4; - uint32_t e1 = idof/(N+1)/4; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,4)]; - uint32_t bcid = sideInfo[INDEX3(4,s1,e1,5,4)]; - if( e2 == 0){ - if( bcid == SELF_BC_NONORMALFLOW ){ - - real u = boundary[SCB_2D_INDEX(i,s1,e1,1,N,nel)]; - real v = boundary[SCB_2D_INDEX(i,s1,e1,2,N,nel)]; - real nx = nhat[VEB_2D_INDEX(i,s1,e1,0,0,N,nel,1)]; - real ny = nhat[VEB_2D_INDEX(i,s1,e1,0,1,N,nel,1)]; - extBoundary[SCB_2D_INDEX(i,s1,e1,0,N,nel)] = boundary[SCB_2D_INDEX(i,s1,e1,0,N,nel)]; // density - extBoundary[SCB_2D_INDEX(i,s1,e1,1,N,nel)] = (ny*ny-nx*nx)*u-2.0*nx*ny*v; // u - extBoundary[SCB_2D_INDEX(i,s1,e1,2,N,nel)] = (nx*nx-ny*ny)*v-2.0*nx*ny*u; //v - extBoundary[SCB_2D_INDEX(i,s1,e1,3,N,nel)] = boundary[SCB_2D_INDEX(i,s1,e1,3,N,nel)]; // pressure - - } else if ( bcid == SELF_BC_RADIATION ){ - - extBoundary[SCB_2D_INDEX(i,s1,e1,0,N,nel)] = 0.0; - extBoundary[SCB_2D_INDEX(i,s1,e1,1,N,nel)] = 0.0; - extBoundary[SCB_2D_INDEX(i,s1,e1,2,N,nel)] = 0.0; - extBoundary[SCB_2D_INDEX(i,s1,e1,3,N,nel)] = 0.0; - - } - - } - } -} - -extern "C" -{ - void setboundarycondition_LinearEuler2D_gpu(real *extBoundary, real *boundary, int *sideInfo, real *nhat, int N, int nel, int nvar){ - int threads_per_block = 256; - int ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,1,1); - dim3 nthreads(threads_per_block,1,1); - - setboundarycondition_LinearEuler2D_gpukernel<<>>(extBoundary,boundary,sideInfo,nhat,N,nel,nvar); - } -} diff --git a/src/gpu/SELF_LinearEuler2D.f90 b/src/gpu/SELF_LinearEuler2D.f90 deleted file mode 100644 index 54e0fbc0e..000000000 --- a/src/gpu/SELF_LinearEuler2D.f90 +++ /dev/null @@ -1,161 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearEuler2D - - use self_LinearEuler2D_t - - implicit none - - type,extends(LinearEuler2D_t) :: LinearEuler2D - contains - procedure :: setboundarycondition => setboundarycondition_LinearEuler2D - procedure :: boundaryflux => boundaryflux_LinearEuler2D - procedure :: fluxmethod => fluxmethod_LinearEuler2D - procedure :: sourcemethod => sourcemethod_LinearEuler2D - - endtype LinearEuler2D - - interface - subroutine setboundarycondition_LinearEuler2D_gpu(extboundary,boundary,sideinfo,nhat,N,nel,nvar) & - bind(c,name="setboundarycondition_LinearEuler2D_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo,nhat - integer(c_int),value :: N,nel,nvar - endsubroutine setboundarycondition_LinearEuler2D_gpu - endinterface - - interface - subroutine fluxmethod_LinearEuler2D_gpu(solution,flux,rho0,c,N,nel,nvar) & - bind(c,name="fluxmethod_LinearEuler2D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,flux - real(c_prec),value :: rho0,c - integer(c_int),value :: N,nel,nvar - endsubroutine fluxmethod_LinearEuler2D_gpu - endinterface - - interface - subroutine boundaryflux_LinearEuler2D_gpu(fb,fextb,nhat,nscale,flux,rho0,c,N,nel,nvar) & - bind(c,name="boundaryflux_LinearEuler2D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,flux,nhat,nscale - real(c_prec),value :: rho0,c - integer(c_int),value :: N,nel,nvar - endsubroutine boundaryflux_LinearEuler2D_gpu - endinterface - -contains - - subroutine sourcemethod_LinearEuler2D(this) - implicit none - class(LinearEuler2D),intent(inout) :: this - - return - - endsubroutine sourcemethod_LinearEuler2D - - subroutine boundaryflux_LinearEuler2D(this) - ! this method uses an linear upwind solver for the - ! advective flux and the bassi-rebay method for the - ! diffusive fluxes - implicit none - class(LinearEuler2D),intent(inout) :: this - - call boundaryflux_LinearEuler2D_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu, & - this%geometry%nhat%boundary_gpu, & - this%geometry%nscale%boundary_gpu, & - this%flux%boundarynormal_gpu, & - this%rho0,this%c,this%solution%interp%N, & - this%solution%nelem,this%solution%nvar) - - endsubroutine boundaryflux_LinearEuler2D - - subroutine fluxmethod_LinearEuler2D(this) - implicit none - class(LinearEuler2D),intent(inout) :: this - - call fluxmethod_LinearEuler2D_gpu(this%solution%interior_gpu, & - this%flux%interior_gpu, & - this%rho0,this%c,this%solution%interp%N,this%solution%nelem, & - this%solution%nvar) - - endsubroutine fluxmethod_LinearEuler2D - - subroutine setboundarycondition_LinearEuler2D(this) - !! Boundary conditions are set to periodic boundary conditions - implicit none - class(LinearEuler2D),intent(inout) :: this - ! local - integer :: i,iEl,j,e2,bcid - real(prec) :: x(1:2) - - if(this%prescribed_bcs_enabled) then - call gpuCheck(hipMemcpy(c_loc(this%solution%extboundary), & - this%solution%extboundary_gpu,sizeof(this%solution%extboundary), & - hipMemcpyDeviceToHost)) - - ! Prescribed boundaries are still done on the GPU - do iEl = 1,this%solution%nElem ! Loop over all elements - do j = 1,4 ! Loop over all sides - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,iEl,1,1:2) - - this%solution%extBoundary(i,j,iEl,1:this%nvar) = & - this%hbc2d_Prescribed(x,this%t) - enddo - - endif - endif - - enddo - enddo - - call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & - c_loc(this%solution%extBoundary), & - sizeof(this%solution%extBoundary), & - hipMemcpyHostToDevice)) - endif - call setboundarycondition_LinearEuler2D_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu, & - this%mesh%sideInfo_gpu, & - this%geometry%nhat%boundary_gpu, & - this%solution%interp%N, & - this%solution%nelem,this%solution%nvar) - - endsubroutine setboundarycondition_LinearEuler2D - -endmodule self_LinearEuler2D diff --git a/src/gpu/SELF_LinearEuler3D.cpp b/src/gpu/SELF_LinearEuler3D.cpp deleted file mode 100644 index c71c4b58f..000000000 --- a/src/gpu/SELF_LinearEuler3D.cpp +++ /dev/null @@ -1,176 +0,0 @@ -/* -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -*/ - -#include "SELF_GPU_Macros.h" - - -__global__ void boundaryflux_LinearEuler3D_kernel(real *fb, real *extfb, real *nhat, real *nmag, real *flux, real rho0, real c, int ndof){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof ){ - - real fl[5]; - real nx = nhat[idof]; - real ny = nhat[idof+ndof]; - real nz = nhat[idof+2*ndof]; - real un = fb[idof + ndof]*nx + fb[idof + 2*ndof]*ny+fb[idof + 3*ndof]*nz; - real p = fb[idof + 4*ndof]; - - fl[0] = rho0*un; // density flux - fl[1] = p*nx/rho0; // x-momentum flux - fl[2] = p*ny/rho0; // y-momentum flux - fl[3] = p*nz/rho0; // z-momentum flux - fl[4] = rho0*c*c*un; // pressure flux - - real fr[5]; - un = extfb[idof + ndof]*nx + extfb[idof + 2*ndof]*ny+extfb[idof + 3*ndof]*nz; - p = extfb[idof + 4*ndof]; - - fr[0] = rho0*un; // density flux - fr[1] = p*nx/rho0; // x-momentum flux - fr[2] = p*ny/rho0; // y-momentum flux - fr[3] = p*nz/rho0; // y-momentum flux - fr[4] = rho0*c*c*un; // pressure flux - - real nm = nmag[idof]; - flux[idof] = (0.5*(fl[0]+fr[0])+c*(fb[idof]-extfb[idof]))*nm; // density - flux[idof+ndof] = (0.5*(fl[1]+fr[1])+c*(fb[idof+ndof]-extfb[idof+ndof]))*nm; // u - flux[idof+2*ndof] = (0.5*(fl[2]+fr[2])+c*(fb[idof+2*ndof]-extfb[idof+2*ndof]))*nm; // v - flux[idof+3*ndof] = (0.5*(fl[3]+fr[3])+c*(fb[idof+3*ndof]-extfb[idof+3*ndof]))*nm; // w - flux[idof+4*ndof] = (0.5*(fl[4]+fr[4])+c*(fb[idof+4*ndof]-extfb[idof+4*ndof]))*nm; // p - } -} - -extern "C" -{ - void boundaryflux_LinearEuler3D_gpu(real *fb, real *extfb,real *nhat, real *nmag, real *flux, real rho0, real c, int N, int nel){ - int threads_per_block = 256; - uint32_t ndof = (N+1)*(N+1)*6*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,1,1); - dim3 nthreads(threads_per_block,1,1); - - boundaryflux_LinearEuler3D_kernel<<>>(fb,extfb,nhat,nmag,flux,rho0,c,ndof); - } -} - - __global__ void fluxmethod_LinearEuler3D_gpukernel(real *solution, real *flux, real rho0, real c, int ndof, int nvar){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof ){ - real u = solution[idof + ndof]; - real v = solution[idof + 2*ndof]; - real w = solution[idof + 3*ndof]; - real p = solution[idof + 4*ndof]; - - flux[idof + ndof*(0 + nvar*0)] = rho0*u; // density, x flux ; rho0*u - flux[idof + ndof*(0 + nvar*1)] = rho0*v; // density, y flux ; rho0*v - flux[idof + ndof*(0 + nvar*2)] = rho0*w; // density, z flux ; rho0*w - - flux[idof + ndof*(1 + nvar*0)] = p/rho0; // x-velocity, x flux; p/rho0 - flux[idof + ndof*(1 + nvar*1)] = 0.0; // x-velocity, y flux; 0 - flux[idof + ndof*(1 + nvar*2)] = 0.0; // x-velocity, z flux; 0 - - flux[idof + ndof*(2 + nvar*0)] = 0.0; // y-velocity, x flux; 0 - flux[idof + ndof*(2 + nvar*1)] = p/rho0; // y-velocity, y flux; p/rho0 - flux[idof + ndof*(2 + nvar*2)] = 0.0; // y-velocity, z flux; 0 - - flux[idof + ndof*(3 + nvar*0)] = 0.0; // z-velocity, x flux; 0 - flux[idof + ndof*(3 + nvar*1)] = 0.0; // z-velocity, y flux; 0 - flux[idof + ndof*(3 + nvar*2)] = p/rho0; // z-velocity, z flux; p/rho0 - - flux[idof + ndof*(4 + nvar*0)] = c*c*rho0*u; // pressure, x flux : rho0*c^2*u - flux[idof + ndof*(4 + nvar*1)] = c*c*rho0*v; // pressure, y flux : rho0*c^2*v - flux[idof + ndof*(4 + nvar*2)] = c*c*rho0*w; // pressure, z flux : rho0*c^2*w - - } - -} -extern "C" -{ - void fluxmethod_LinearEuler3D_gpu(real *solution, real *flux, real rho0, real c, int N, int nel, int nvar){ - int ndof = (N+1)*(N+1)*(N+1)*nel; - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - fluxmethod_LinearEuler3D_gpukernel<<>>(solution,flux,rho0,c,ndof,nvar); - } - -} -__global__ void setboundarycondition_LinearEuler3D_gpukernel(real *extBoundary, real *boundary, int *sideInfo, real *nhat, int N, int nel){ - - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*(N+1)*6*nel; - - if(idof < ndof){ - uint32_t i = idof % (N+1); - uint32_t j = (idof/(N+1)) % (N+1); - uint32_t s1 = (idof/(N+1)/(N+1)) % 6; - uint32_t e1 = idof/(N+1)/(N+1)/6; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,4)]; - uint32_t bcid = sideInfo[INDEX3(4,s1,e1,5,4)]; - if( e2 == 0){ - // if( bcid == SELF_BC_NONORMALFLOW ){ - - // real u = boundary[SCB_3D_INDEX(i,s1,e1,1,N,nel)]; - // real v = boundary[SCB_3D_INDEX(i,s1,e1,2,N,nel)]; - // real nx = nhat[VEB_3D_INDEX(i,s1,e1,0,0,N,nel,1)]; - // real ny = nhat[VEB_3D_INDEX(i,s1,e1,0,1,N,nel,1)]; - // extBoundary[SCB_3D_INDEX(i,s1,e1,0,N,nel)] = boundary[SCB_3D_INDEX(i,s1,e1,0,N,nel)]; // density - // extBoundary[SCB_3D_INDEX(i,s1,e1,1,N,nel)] = (ny*ny-nx*nx)*u-2.0*nx*ny*v; // u - // extBoundary[SCB_3D_INDEX(i,s1,e1,2,N,nel)] = (nx*nx-ny*ny)*v-2.0*nx*ny*u; //v - // extBoundary[SCB_3D_INDEX(i,s1,e1,3,N,nel)] = boundary[SCB_3D_INDEX(i,s1,e1,3,N,nel)]; // pressure - - // } else - if ( bcid == SELF_BC_RADIATION ){ - - extBoundary[SCB_3D_INDEX(i,j,s1,e1,0,N,nel)] = 0.0; - extBoundary[SCB_3D_INDEX(i,j,s1,e1,1,N,nel)] = 0.0; - extBoundary[SCB_3D_INDEX(i,j,s1,e1,2,N,nel)] = 0.0; - extBoundary[SCB_3D_INDEX(i,j,s1,e1,3,N,nel)] = 0.0; - extBoundary[SCB_3D_INDEX(i,j,s1,e1,4,N,nel)] = 0.0; - - } - - } - } -} - -extern "C" -{ - void setboundarycondition_LinearEuler3D_gpu(real *extBoundary, real *boundary, int *sideInfo, real *nhat, int N, int nel){ - int threads_per_block = 256; - int ndof = (N+1)*(N+1)*6*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,1,1); - dim3 nthreads(threads_per_block,1,1); - - setboundarycondition_LinearEuler3D_gpukernel<<>>(extBoundary,boundary,sideInfo,nhat,N,nel); - } -} diff --git a/src/gpu/SELF_LinearEuler3D.f90 b/src/gpu/SELF_LinearEuler3D.f90 deleted file mode 100644 index 76190a383..000000000 --- a/src/gpu/SELF_LinearEuler3D.f90 +++ /dev/null @@ -1,151 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearEuler3D - - use self_LinearEuler3D_t - - implicit none - - type,extends(LinearEuler3D_t) :: LinearEuler3D - contains - procedure :: setboundarycondition => setboundarycondition_LinearEuler3D - procedure :: boundaryflux => boundaryflux_LinearEuler3D - procedure :: fluxmethod => fluxmethod_LinearEuler3D - - endtype LinearEuler3D - - interface - subroutine setboundarycondition_LinearEuler3D_gpu(extboundary,boundary,sideinfo,nhat,N,nel) & - bind(c,name="setboundarycondition_LinearEuler3D_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo,nhat - integer(c_int),value :: N,nel - endsubroutine setboundarycondition_LinearEuler3D_gpu - endinterface - - interface - subroutine fluxmethod_LinearEuler3D_gpu(solution,flux,rho0,c,N,nel,nvar) & - bind(c,name="fluxmethod_LinearEuler3D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,flux - real(c_prec),value :: rho0,c - integer(c_int),value :: N,nel,nvar - endsubroutine fluxmethod_LinearEuler3D_gpu - endinterface - - interface - subroutine boundaryflux_LinearEuler3D_gpu(fb,fextb,nhat,nscale,flux,rho0,c,N,nel) & - bind(c,name="boundaryflux_LinearEuler3D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,flux,nhat,nscale - real(c_prec),value :: rho0,c - integer(c_int),value :: N,nel - endsubroutine boundaryflux_LinearEuler3D_gpu - endinterface - -contains - - subroutine boundaryflux_LinearEuler3D(this) - implicit none - class(LinearEuler3D),intent(inout) :: this - - call boundaryflux_LinearEuler3D_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu, & - this%geometry%nhat%boundary_gpu, & - this%geometry%nscale%boundary_gpu, & - this%flux%boundarynormal_gpu, & - this%rho0,this%c,this%solution%interp%N, & - this%solution%nelem) - - endsubroutine boundaryflux_LinearEuler3D - - subroutine fluxmethod_LinearEuler3D(this) - implicit none - class(LinearEuler3D),intent(inout) :: this - - call fluxmethod_LinearEuler3D_gpu(this%solution%interior_gpu, & - this%flux%interior_gpu, & - this%rho0,this%c,this%solution%interp%N,this%solution%nelem, & - this%solution%nvar) - - endsubroutine fluxmethod_LinearEuler3D - - subroutine setboundarycondition_LinearEuler3D(this) - !! Boundary conditions are set to periodic boundary conditions - implicit none - class(LinearEuler3D),intent(inout) :: this - ! local - integer :: i,iEl,j,k,e2,bcid - real(prec) :: x(1:3) - - if(this%prescribed_bcs_enabled) then - call gpuCheck(hipMemcpy(c_loc(this%solution%extboundary), & - this%solution%extboundary_gpu,sizeof(this%solution%extboundary), & - hipMemcpyDeviceToHost)) - - ! Prescribed boundaries are still done on the CPU - do iEl = 1,this%solution%nElem ! Loop over all elements - do k = 1,6 ! Loop over all sides - - bcid = this%mesh%sideInfo(5,j,iEl) ! Boundary Condition ID - e2 = this%mesh%sideInfo(3,j,iEl) ! Neighboring Element ID - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - - do j = 1,this%solution%interp%N+1 ! Loop over quadrature points - do i = 1,this%solution%interp%N+1 ! Loop over quadrature points - x = this%geometry%x%boundary(i,j,k,iEl,1,1:3) - - this%solution%extBoundary(i,j,k,iEl,1:this%nvar) = & - this%hbc3D_Prescribed(x,this%t) - enddo - enddo - - endif - endif - - enddo - enddo - - call gpuCheck(hipMemcpy(this%solution%extBoundary_gpu, & - c_loc(this%solution%extBoundary), & - sizeof(this%solution%extBoundary), & - hipMemcpyHostToDevice)) - endif - call setboundarycondition_LinearEuler3D_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu, & - this%mesh%sideInfo_gpu, & - this%geometry%nhat%boundary_gpu, & - this%solution%interp%N, & - this%solution%nelem) - - endsubroutine setboundarycondition_LinearEuler3D - -endmodule self_LinearEuler3D diff --git a/src/gpu/SELF_LinearShallowWater2D.cpp b/src/gpu/SELF_LinearShallowWater2D.cpp deleted file mode 100644 index 7d68dbeab..000000000 --- a/src/gpu/SELF_LinearShallowWater2D.cpp +++ /dev/null @@ -1,168 +0,0 @@ -/* -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -*/ - -#include "SELF_GPU_Macros.h" - -__global__ void boundaryflux_LinearShallowWater2D_kernel(real *fb, real *extfb, real *nhat, real *nmag, real *flux, real g, real H, int ndof){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof){ - - real nx = nhat[idof]; - real ny = nhat[idof+ndof]; - real nm = nmag[idof]; - - real fl[3]; - fl[0] = fb[idof]; // uL - fl[1] = fb[idof + ndof]; // vL - fl[2] = fb[idof + 2*ndof]; // etaL - - real fr[3]; - fr[0] = extfb[idof]; // uR - fr[1] = extfb[idof + ndof]; // vR - fr[2] = extfb[idof + 2*ndof]; // etaR - - real unL = fl[0] * nx + fl[1] * ny; - real unR = fr[0] * nx + fr[1] * ny; - - real c = sqrt(g * H); - - flux[idof] = 0.5 * (g * (fl[2] + fr[2]) + c * (unL - unR)) * nx * nm; - flux[idof + ndof] = 0.5 * (g * (fl[2] + fr[2]) + c * (unL - unR)) * ny * nm; - flux[idof + 2*ndof] = 0.5 * (H * (unL + unR) + c * (fl[2] - fr[2])) * nm; - } -} - -extern "C" -{ - void boundaryflux_LinearShallowWater2D_gpu(real *fb, real *extfb, real *nhat, real *nmag, real *flux, real g, real H, int N, int nel, int nvar){ - int threads_per_block = 256; - uint32_t ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block + 1; - - dim3 nblocks(nblocks_x, nvar, 1); - dim3 nthreads(threads_per_block, 1, 1); - - boundaryflux_LinearShallowWater2D_kernel<<>>(fb,extfb,nhat,nmag,flux,g,H,ndof); - } -} - -__global__ void fluxmethod_LinearShallowWater2D_gpukernel(real *solution, real *flux, real g, real H, int ndof, int nvar){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof ){ - real u = solution[idof]; - real v = solution[idof + ndof]; - real eta = solution[idof + 2*ndof]; - - flux[idof + ndof*(0 + nvar*0)] = g*eta; // x-component of u - flux[idof + ndof*(0 + nvar*1)] = 0.0; // y-component of u - flux[idof + ndof*(1 + nvar*0)] = 0.0; // x-component of v - flux[idof + ndof*(1 + nvar*1)] = g*eta; // y-component of v - flux[idof + ndof*(2 + nvar*0)] = H*u; // x-component of eta - flux[idof + ndof*(2 + nvar*1)] = H*v; // y-component of eta - - } - -} -extern "C" -{ - void fluxmethod_LinearShallowWater2D_gpu(real *solution, real *flux, real g, real H, int N, int nel, int nvar){ - int ndof = (N+1)*(N+1)*nel; - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - fluxmethod_LinearShallowWater2D_gpukernel<<>>(solution,flux,g,H,ndof,nvar); - } -} - -__global__ void setboundarycondition_LinearShallowWater2D_gpukernel(real *extBoundary, real *boundary, int *sideInfo, real *nhat, int N, int nEl, int nvar){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*4*nEl; - - if(idof < ndof){ - uint32_t i = idof % (N+1); - uint32_t s1 = (idof/(N+1)) % 4; - uint32_t e1 = idof/(N+1)/4; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,4)]; - uint32_t bcid = sideInfo[INDEX3(4,s1,e1,5,4)]; - if( e2 == 0){ - if( bcid == SELF_BC_NONORMALFLOW){ - real u = boundary[SCB_2D_INDEX(i,s1,e1,0,N,nEl)]; - real v = boundary[SCB_2D_INDEX(i,s1,e1,1,N,nEl)]; - real eta = boundary[SCB_2D_INDEX(i,s1,e1,2,N,nEl)]; - real nx = nhat[VEB_2D_INDEX(i,s1,e1,0,0,N,nEl,1)]; - real ny = nhat[VEB_2D_INDEX(i,s1,e1,0,1,N,nEl,1)]; - - extBoundary[SCB_2D_INDEX(i,s1,e1,0,N,nEl)] = (ny * ny - nx * nx) * u - 2 * nx * ny * v; - extBoundary[SCB_2D_INDEX(i,s1,e1,1,N,nEl)] = (nx * nx - ny * ny) * v - 2 * nx * ny * u; - extBoundary[SCB_2D_INDEX(i,s1,e1,2,N,nEl)] = eta; - } else if ( bcid == SELF_BC_RADIATION){ - extBoundary[SCB_2D_INDEX(i,s1,e1,0,N,nEl)] = 0.0; - extBoundary[SCB_2D_INDEX(i,s1,e1,1,N,nEl)] = 0.0; - extBoundary[SCB_2D_INDEX(i,s1,e1,2,N,nEl)] = 0.0; - } - } - } -} - -extern "C" -{ - void setboundarycondition_LinearShallowWater2D_gpu(real *extBoundary, real *boundary, int *sideInfo, real *nhat, int N, int nel, int nvar){ - int threads_per_block = 256; - int ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,1,1); - dim3 nthreads(threads_per_block,1,1); - - setboundarycondition_LinearShallowWater2D_gpukernel<<>>(extBoundary,boundary,sideInfo,nhat,N,nel,nvar); - } -} - -__global__ void sourcemethod_LinearShallowWater2D_gpukernel(real *solution, real *source, real *fCori, real Cd, int ndof){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - - if( idof < ndof ){ - real u = solution[idof]; - real v = solution[idof + ndof]; - - source[idof] = fCori[idof]*v - Cd*u; // du/dt = fv - Cd*u - source[idof+ndof] = -fCori[idof]*u - Cd*v; // dv/dt = -fu - Cd*v - - } - -} -extern "C" -{ - void sourcemethod_LinearShallowWater2D_gpu(real *solution, real *source, real *fCori, real Cd, int N, int nel, int nvar){ - int ndof = (N+1)*(N+1)*nel; - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - sourcemethod_LinearShallowWater2D_gpukernel<<>>(solution,source,fCori,Cd,ndof); - } -} \ No newline at end of file diff --git a/src/gpu/SELF_LinearShallowWater2D.f90 b/src/gpu/SELF_LinearShallowWater2D.f90 deleted file mode 100644 index 9ae072d4f..000000000 --- a/src/gpu/SELF_LinearShallowWater2D.f90 +++ /dev/null @@ -1,176 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_LinearShallowWater2D - - use self_LinearShallowWater2D_t - - implicit none - - type,extends(LinearShallowWater2D_t) :: LinearShallowWater2D - contains - procedure :: setboundarycondition => setboundarycondition_LinearShallowWater2D - procedure :: boundaryflux => boundaryflux_LinearShallowWater2D - procedure :: fluxmethod => fluxmethod_LinearShallowWater2D - procedure :: sourcemethod => sourcemethod_LinearShallowWater2D - - endtype LinearShallowWater2D - - interface - subroutine setboundarycondition_LinearShallowWater2D_gpu(extboundary,boundary,sideinfo,nhat,N,nel,nvar) & - bind(c,name="setboundarycondition_LinearShallowWater2D_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo,nhat - integer(c_int),value :: N,nel,nvar - endsubroutine setboundarycondition_LinearShallowWater2D_gpu - endinterface - - interface - subroutine boundaryflux_LinearShallowWater2D_gpu(fb,fextb,nhat,nscale,flux,g,H,N,nel,nvar) & - bind(c,name="boundaryflux_LinearShallowWater2D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,flux,nhat,nscale - real(c_prec),value :: g,H - integer(c_int),value :: N,nel,nvar - endsubroutine boundaryflux_LinearShallowWater2D_gpu - endinterface - - interface - subroutine fluxmethod_LinearShallowWater2D_gpu(solution,flux,g,H,N,nel,nvar) & - bind(c,name="fluxmethod_LinearShallowWater2D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,flux - real(c_prec),value :: g,H - integer(c_int),value :: N,nel,nvar - endsubroutine fluxmethod_LinearShallowWater2D_gpu - endinterface - - interface - subroutine sourcemethod_LinearShallowWater2D_gpu(solution,source,fCori,Cd,N,nel,nvar) & - bind(c,name="sourcemethod_LinearShallowWater2D_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,source,fCori - real(c_prec),value :: Cd - integer(c_int),value :: N,nel,nvar - endsubroutine sourcemethod_LinearShallowWater2D_gpu - endinterface - -contains - - subroutine boundaryflux_LinearShallowWater2D(this) - implicit none - class(LinearShallowWater2D),intent(inout) :: this - - call boundaryflux_LinearShallowWater2D_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu, & - this%geometry%nhat%boundary_gpu, & - this%geometry%nscale%boundary_gpu, & - this%flux%boundaryNormal_gpu, & - this%g, & - this%H, & - this%solution%interp%N, & - this%solution%nelem, & - this%solution%nvar) - - endsubroutine boundaryflux_LinearShallowWater2D - - subroutine setboundarycondition_LinearShallowWater2D(this) - implicit none - class(LinearShallowWater2D),intent(inout) :: this - integer :: i,iel,j,e2,bcid - real(prec) :: x(1:2) - - if(this%prescribed_bcs_enabled) then - call gpuCheck(hipMemcpy(c_loc(this%solution%extBoundary), & - this%solution%extBoundary_gpu, & - sizeof(this%solution%extBoundary), & - hipMemcpyDeviceToHost)) - do iel = 1,this%solution%nelem - do j = 1,4 - bcid = this%mesh%sideinfo(5,j,iel) - e2 = this%mesh%sideinfo(3,j,iel) - - if(e2 == 0) then - if(bcid == SELF_BC_PRESCRIBED) then - do i = 1,this%solution%interp%N+1 - x = this%geometry%x%boundary(i,j,iel,1,1:2) - this%solution%extBoundary(i,j,iel,1:this%nvar) = & - this%hbc2d_Prescribed(x,this%t) - enddo - endif - endif - enddo - enddo - - call gpucheck(hipMemcpy(this%solution%extBoundary_gpu, & - c_loc(this%solution%extBoundary), & - sizeof(this%solution%extBoundary), & - hipMemcpyHostToDevice)) - - endif - - call setboundarycondition_LinearShallowWater2D_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu, & - this%mesh%sideInfo_gpu, & - this%geometry%nhat%boundary_gpu, & - this%solution%interp%N, & - this%solution%nelem, & - this%solution%nvar) - - endsubroutine setboundarycondition_LinearShallowWater2D - - subroutine fluxmethod_LinearShallowWater2D(this) - implicit none - class(LinearShallowWater2D),intent(inout) :: this - - call fluxmethod_LinearShallowWater2D_gpu(this%solution%interior_gpu, & - this%flux%interior_gpu, & - this%g, & - this%H, & - this%solution%interp%N, & - this%solution%nelem, & - this%solution%nvar) - - endsubroutine fluxmethod_LinearShallowWater2D - - subroutine sourcemethod_LinearShallowWater2D(this) - implicit none - class(LinearShallowWater2D),intent(inout) :: this - - call sourcemethod_LinearShallowWater2D_gpu(this%solution%interior_gpu, & - this%source%interior_gpu, & - this%fCori%interior_gpu, & - this%Cd, & - this%solution%interp%N, & - this%solution%nelem, & - this%solution%nvar) - - endsubroutine sourcemethod_LinearShallowWater2D - -endmodule self_LinearShallowWater2D diff --git a/src/gpu/SELF_advection_diffusion_1d.cpp b/src/gpu/SELF_advection_diffusion_1d.cpp deleted file mode 100644 index 7033cd5c2..000000000 --- a/src/gpu/SELF_advection_diffusion_1d.cpp +++ /dev/null @@ -1,70 +0,0 @@ -#include "SELF_GPU_Macros.h" - - -__global__ void setboundarycondition_advection_diffusion_1d_gpukernel(real *extBoundary, real *boundary, int nel, int nvar){ - - uint32_t ivar = threadIdx.x + blockIdx.x*blockDim.x; - if(ivar < nvar){ - extBoundary[SCB_1D_INDEX(0,0,ivar,nel)] = boundary[SCB_1D_INDEX(1,nel-1,ivar,nel)]; - extBoundary[SCB_1D_INDEX(1,nel-1,ivar,nel)] = boundary[SCB_1D_INDEX(0,0,ivar,nel)]; - } - -} - -extern "C" -{ - void setboundarycondition_advection_diffusion_1d_gpu(real *extBoundary, real *boundary, int nel, int nvar){ - int threads_per_block = 64; - int nblocks_x = nvar/threads_per_block +1; - setboundarycondition_advection_diffusion_1d_gpukernel<<>>(extBoundary,boundary,nel,nvar); - } -} - -__global__ void fluxmethod_advection_diffusion_1d_gpukernel(real *solution, real *solutiongradient, real *flux, real u, real nu, int ndof){ - uint32_t i = threadIdx.x + blockIdx.x*blockDim.x; - - if( i < ndof ){ - flux[i] = u*solution[i] - nu*solutiongradient[i]; - } - -} -extern "C" -{ - void fluxmethod_advection_diffusion_1d_gpu(real *solution, real *solutiongradient, real *flux, real u, real nu, int ndof){ - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - fluxmethod_advection_diffusion_1d_gpukernel<<>>(solution,solutiongradient,flux,u,nu,ndof); - } - -} - -__global__ void boundaryflux_advection_diffusion_1d_gpukernel(real *fb, real *fextb, real *dfavg, real *flux, real u, real nu, int ndof){ - uint32_t i = threadIdx.x + blockIdx.x*blockDim.x; - // when i is even, we are looking at the left side of the element and the boundary normal is negative - // when i is odd, we are looking at the right side of the element and boundary normal is positive - // - // i%2 is 0 when i is even - // 1 when i is odd - // - // 2*(i%2) is 0 when i is even - // 2 when i is odd - // - // 2*(i%2)-1 is -1 when i is even - // 1 when i is odd - real nhat = 2.0*(i%2)-1.0; - - if( i < ndof ){ - flux[i] = 0.5*(u*nhat*(fb[i]+fextb[i]) + fabsf(u*nhat)*(fb[i]-fextb[i])) - nu*dfavg[i]*nhat; - } - -} -extern "C" -{ - void boundaryflux_advection_diffusion_1d_gpu(real *fb, real *fextb, real *dfavg, real *flux, real u, real nu, int ndof){ - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - boundaryflux_advection_diffusion_1d_gpukernel<<>>(fb,fextb,dfavg,flux,u,nu,ndof); - } - -} - diff --git a/src/gpu/SELF_advection_diffusion_1d.f90 b/src/gpu/SELF_advection_diffusion_1d.f90 deleted file mode 100644 index 126408f1a..000000000 --- a/src/gpu/SELF_advection_diffusion_1d.f90 +++ /dev/null @@ -1,128 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_1d - - use self_dgmodel1d - use self_advection_diffusion_1d_t - use SELF_GPU - - implicit none - - type,extends(advection_diffusion_1d_t) :: advection_diffusion_1d - - contains - procedure :: setboundarycondition => setboundarycondition_advection_diffusion_1d - procedure :: setgradientboundarycondition => setgradientboundarycondition_advection_diffusion_1d - procedure :: boundaryflux => boundaryflux_advection_diffusion_1d - procedure :: fluxmethod => fluxmethod_advection_diffusion_1d - - endtype advection_diffusion_1d - - interface - subroutine setboundarycondition_advection_diffusion_1d_gpu(extboundary,boundary,nel,nvar) & - bind(c,name="setboundarycondition_advection_diffusion_1d_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary - integer(c_int),value :: nel,nvar - endsubroutine setboundarycondition_advection_diffusion_1d_gpu - endinterface - - interface - subroutine fluxmethod_advection_diffusion_1d_gpu(solution,solutiongradient,flux,u,nu,ndof) & - bind(c,name="fluxmethod_advection_diffusion_1d_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,solutiongradient,flux - real(c_prec),value :: u,nu - integer(c_int),value :: ndof - endsubroutine fluxmethod_advection_diffusion_1d_gpu - endinterface - - interface - subroutine boundaryflux_advection_diffusion_1d_gpu(fb,fextb,dfavg,flux,u,nu,ndof) & - bind(c,name="boundaryflux_advection_diffusion_1d_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,dfavg,flux - real(c_prec),value :: u,nu - integer(c_int),value :: ndof - endsubroutine boundaryflux_advection_diffusion_1d_gpu - endinterface - -contains - - subroutine setboundarycondition_advection_diffusion_1d(this) - !! Boundary conditions are set to periodic boundary conditions - implicit none - class(advection_diffusion_1d),intent(inout) :: this - - call setboundarycondition_advection_diffusion_1d_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu,this%solution%nelem,this%solution%nvar) - - endsubroutine setboundarycondition_advection_diffusion_1d - - subroutine setgradientboundarycondition_advection_diffusion_1d(this) - !! Gradient boundary conditions are set to periodic boundary conditions - implicit none - class(advection_diffusion_1d),intent(inout) :: this - - call setboundarycondition_advection_diffusion_1d_gpu(this%solutiongradient%extboundary_gpu, & - this%solutiongradient%boundary_gpu,this%solution%nelem,this%solution%nvar) - - endsubroutine setgradientboundarycondition_advection_diffusion_1d - - subroutine fluxmethod_advection_diffusion_1d(this) - implicit none - class(advection_diffusion_1d),intent(inout) :: this - ! Local - integer :: ndof - - ndof = this%solution%nelem*this%solution%nvar*(this%solution%interp%N+1) - - call fluxmethod_advection_diffusion_1d_gpu(this%solution%interior_gpu, & - this%solutiongradient%interior_gpu,this%flux%interior_gpu, & - this%u,this%nu,ndof) - - endsubroutine fluxmethod_advection_diffusion_1d - - subroutine boundaryflux_advection_diffusion_1d(this) - ! this method uses an linear upwind solver for the - ! advective flux and the bassi-rebay method for the - ! diffusive fluxes - implicit none - class(advection_diffusion_1d),intent(inout) :: this - ! Local - integer :: ndof - - ndof = this%solution%nelem*this%solution%nvar*2 - call boundaryflux_advection_diffusion_1d_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu,this%solutionGradient%avgBoundary_gpu, & - this%flux%boundarynormal_gpu,this%u,this%nu,ndof) - - endsubroutine boundaryflux_advection_diffusion_1d - -endmodule self_advection_diffusion_1d diff --git a/src/gpu/SELF_advection_diffusion_2d.cpp b/src/gpu/SELF_advection_diffusion_2d.cpp deleted file mode 100644 index b8175724a..000000000 --- a/src/gpu/SELF_advection_diffusion_2d.cpp +++ /dev/null @@ -1,128 +0,0 @@ -#include "SELF_GPU_Macros.h" - - -__global__ void setboundarycondition_advection_diffusion_2d_gpukernel(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*4*nel; - - if(idof < ndof){ - uint32_t i = idof % (N+1); - uint32_t s1 = (idof/(N+1)) % 4; - uint32_t e1 = idof/(N+1)/4; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,4)]; - if( e2 == 0){ - uint32_t ivar = blockIdx.y; - extBoundary[SCB_2D_INDEX(i,s1,e1,ivar,N,nel)] = 0.0; - } - } -} - -extern "C" -{ - void setboundarycondition_advection_diffusion_2d_gpu(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - int threads_per_block = 256; - int ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,1); - dim3 nthreads(threads_per_block,1,1); - - setboundarycondition_advection_diffusion_2d_gpukernel<<>>(extBoundary,boundary,sideInfo,N,nel,nvar); - } -} - -__global__ void setgradientboundarycondition_advection_diffusion_2d_gpukernel(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*4*nel; - - if(idof < ndof){ - uint32_t i = idof%(N+1); - uint32_t s1 = (idof/(N+1))%4; - uint32_t e1 = idof/(N+1)/4; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,4)]; - if( e2 == 0){ - uint32_t ivar = blockIdx.y; - uint32_t idir = blockIdx.z; - extBoundary[VEB_2D_INDEX(i,s1,e1,ivar,idir,N,nel,nvar)] = boundary[VEB_2D_INDEX(i,s1,e1,ivar,idir,N,nel,nvar)]; - } - } -} - -extern "C" -{ - void setgradientboundarycondition_advection_diffusion_2d_gpu(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - int threads_per_block = 256; - int ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,2); - dim3 nthreads(threads_per_block,1,1); - - setgradientboundarycondition_advection_diffusion_2d_gpukernel<<>>(extBoundary,boundary,sideInfo,N,nel,nvar); - } -} - -__global__ void fluxmethod_advection_diffusion_2d_gpukernel(real *solution, real *solutiongradient, real *flux, real u, real v, real nu, int ndof){ - uint32_t i = threadIdx.x + blockIdx.x*blockDim.x; - - if( i < ndof ){ - flux[i] = u*solution[i] - nu*solutiongradient[i]; - flux[i+ndof] = v*solution[i] - nu*solutiongradient[i+ndof]; - } - -} -extern "C" -{ - void fluxmethod_advection_diffusion_2d_gpu(real *solution, real *solutiongradient, real *flux, real u, real v, real nu, int N, int nel, int nvar){ - int ndof = (N+1)*(N+1)*nel*nvar; - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - fluxmethod_advection_diffusion_2d_gpukernel<<>>(solution,solutiongradient,flux,u,v,nu,ndof); - } - -} - -__global__ void boundaryflux_advection_diffusion_2d_gpukernel(real *fb, real *fextb, real *dfavg, real *nhat, real *nscale, real *flux, real u, real v, real nu, int N, int nel, int nvar){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*4*nel; - - if( idof < ndof ){ - - uint32_t i = idof % (N+1); - uint32_t j = (idof/(N+1)) % 4; - uint32_t iel = idof/(N+1)/4; - uint32_t ivar = blockIdx.y; - - real nx = nhat[VEB_2D_INDEX(i,j,iel,0,0,N,nel,1)]; - real ny = nhat[VEB_2D_INDEX(i,j,iel,0,1,N,nel,1)]; - - real un = u*nx+v*ny; - - real dfdn = dfavg[VEB_2D_INDEX(i,j,iel,ivar,0,N,nel,nvar)]*nx+ - dfavg[VEB_2D_INDEX(i,j,iel,ivar,1,N,nel,nvar)]*ny; - - real nmag = nscale[SCB_2D_INDEX(i,j,iel,0,N,nel)]; - - flux[idof+ivar*ndof] = (0.5*(un*(fb[idof+ivar*ndof]+fextb[idof+ivar*ndof])+ - fabsf(un)*(fb[idof+ivar*ndof]-fextb[idof+ivar*ndof]))- - nu*dfdn)*nmag; - } - -} -extern "C" -{ - void boundaryflux_advection_diffusion_2d_gpu(real *fb, real *fextb, real *dfavg, real *nhat, real *nscale, real *flux, real u, real v, real nu, int N, int nel, int nvar){ - int threads_per_block = 256; - uint32_t ndof = (N+1)*4*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,1); - dim3 nthreads(threads_per_block,1,1); - - boundaryflux_advection_diffusion_2d_gpukernel<<>>(fb,fextb,dfavg,nhat,nscale,flux,u,v,nu,N,nel,nvar); - } - -} - diff --git a/src/gpu/SELF_advection_diffusion_2d.f90 b/src/gpu/SELF_advection_diffusion_2d.f90 deleted file mode 100644 index 681ddafe4..000000000 --- a/src/gpu/SELF_advection_diffusion_2d.f90 +++ /dev/null @@ -1,134 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_2d - - use self_advection_diffusion_2d_t - - implicit none - - type,extends(advection_diffusion_2d_t) :: advection_diffusion_2d - - contains - procedure :: setboundarycondition => setboundarycondition_advection_diffusion_2d - procedure :: setgradientboundarycondition => setgradientboundarycondition_advection_diffusion_2d - procedure :: boundaryflux => boundaryflux_advection_diffusion_2d - procedure :: fluxmethod => fluxmethod_advection_diffusion_2d - - endtype advection_diffusion_2d - - interface - subroutine setboundarycondition_advection_diffusion_2d_gpu(extboundary,boundary,sideinfo,N,nel,nvar) & - bind(c,name="setboundarycondition_advection_diffusion_2d_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo - integer(c_int),value :: N,nel,nvar - endsubroutine setboundarycondition_advection_diffusion_2d_gpu - endinterface - - interface - subroutine setgradientboundarycondition_advection_diffusion_2d_gpu(extboundary,boundary,sideinfo,N,nel,nvar) & - bind(c,name="setgradientboundarycondition_advection_diffusion_2d_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo - integer(c_int),value :: N,nel,nvar - endsubroutine setgradientboundarycondition_advection_diffusion_2d_gpu - endinterface - - interface - subroutine fluxmethod_advection_diffusion_2d_gpu(solution,solutiongradient,flux,u,v,nu,N,nel,nvar) & - bind(c,name="fluxmethod_advection_diffusion_2d_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,solutiongradient,flux - real(c_prec),value :: u,v,nu - integer(c_int),value :: N,nel,nvar - endsubroutine fluxmethod_advection_diffusion_2d_gpu - endinterface - - interface - subroutine boundaryflux_advection_diffusion_2d_gpu(fb,fextb,dfavg,nhat,nscale,flux,u,v,nu,N,nel,nvar) & - bind(c,name="boundaryflux_advection_diffusion_2d_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,dfavg,flux,nhat,nscale - real(c_prec),value :: u,v,nu - integer(c_int),value :: N,nel,nvar - endsubroutine boundaryflux_advection_diffusion_2d_gpu - endinterface - -contains - - subroutine setboundarycondition_advection_diffusion_2d(this) - !! Boundary conditions are set to periodic boundary conditions - implicit none - class(advection_diffusion_2d),intent(inout) :: this - - call setboundarycondition_advection_diffusion_2d_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu,this%mesh%sideInfo_gpu,this%solution%interp%N, & - this%solution%nelem,this%solution%nvar) - - endsubroutine setboundarycondition_advection_diffusion_2d - - subroutine setgradientboundarycondition_advection_diffusion_2d(this) - !! Gradient boundary conditions are set to periodic boundary conditions - implicit none - class(advection_diffusion_2d),intent(inout) :: this - - call setgradientboundarycondition_advection_diffusion_2d_gpu( & - this%solutiongradient%extboundary_gpu, & - this%solutiongradient%boundary_gpu,this%mesh%sideInfo_gpu, & - this%solution%interp%N,this%solution%nelem,this%solution%nvar) - - endsubroutine setgradientboundarycondition_advection_diffusion_2d - - subroutine fluxmethod_advection_diffusion_2d(this) - implicit none - class(advection_diffusion_2d),intent(inout) :: this - - call fluxmethod_advection_diffusion_2d_gpu(this%solution%interior_gpu, & - this%solutiongradient%interior_gpu,this%flux%interior_gpu, & - this%u,this%v,this%nu,this%solution%interp%N,this%solution%nelem, & - this%solution%nvar) - - endsubroutine fluxmethod_advection_diffusion_2d - - subroutine boundaryflux_advection_diffusion_2d(this) - ! this method uses an linear upwind solver for the - ! advective flux and the bassi-rebay method for the - ! diffusive fluxes - implicit none - class(advection_diffusion_2d),intent(inout) :: this - - call boundaryflux_advection_diffusion_2d_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu,this%solutionGradient%avgBoundary_gpu, & - this%geometry%nhat%boundary_gpu,this%geometry%nscale%boundary_gpu, & - this%flux%boundarynormal_gpu,this%u,this%v,this%nu,this%solution%interp%N, & - this%solution%nelem,this%solution%nvar) - - endsubroutine boundaryflux_advection_diffusion_2d - -endmodule self_advection_diffusion_2d diff --git a/src/gpu/SELF_advection_diffusion_3d.cpp b/src/gpu/SELF_advection_diffusion_3d.cpp deleted file mode 100644 index daea4294e..000000000 --- a/src/gpu/SELF_advection_diffusion_3d.cpp +++ /dev/null @@ -1,134 +0,0 @@ -#include "SELF_GPU_Macros.h" - - -__global__ void setboundarycondition_advection_diffusion_3d_gpukernel(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*(N+1)*6*nel; - - if(idof < ndof){ - uint32_t i = idof % (N+1); - uint32_t j = (idof/(N+1)) % (N+1); - uint32_t s1 = (idof/(N+1)/(N+1)) % 6; - uint32_t e1 = idof/(N+1)/(N+1)/6; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,6)]; - if( e2 == 0){ - uint32_t ivar = blockIdx.y; - extBoundary[SCB_3D_INDEX(i,j,s1,e1,ivar,N,nel)] = 0.0; - } - } -} - -extern "C" -{ - void setboundarycondition_advection_diffusion_3d_gpu(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - int threads_per_block = 256; - int ndof = (N+1)*(N+1)*6*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,1); - dim3 nthreads(threads_per_block,1,1); - - setboundarycondition_advection_diffusion_3d_gpukernel<<>>(extBoundary,boundary,sideInfo,N,nel,nvar); - } -} - -__global__ void setgradientboundarycondition_advection_diffusion_3d_gpukernel(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*(N+1)*6*nel; - - if(idof < ndof){ - uint32_t i = idof % (N+1); - uint32_t j = (idof/(N+1)) % (N+1); - uint32_t s1 = (idof/(N+1)/(N+1)) % 6; - uint32_t e1 = idof/(N+1)/(N+1)/6; - uint32_t e2 = sideInfo[INDEX3(2,s1,e1,5,6)]; - if( e2 == 0){ - uint32_t ivar = blockIdx.y; - uint32_t idir = blockIdx.z; - extBoundary[VEB_3D_INDEX(i,j,s1,e1,ivar,idir,N,nel,nvar)] = boundary[VEB_3D_INDEX(i,j,s1,e1,ivar,idir,N,nel,nvar)]; - } - } -} - -extern "C" -{ - void setgradientboundarycondition_advection_diffusion_3d_gpu(real *extBoundary, real *boundary, int *sideInfo, int N, int nel, int nvar){ - int threads_per_block = 256; - int ndof = (N+1)*(N+1)*6*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,3); - dim3 nthreads(threads_per_block,1,1); - - setgradientboundarycondition_advection_diffusion_3d_gpukernel<<>>(extBoundary,boundary,sideInfo,N,nel,nvar); - } -} - -__global__ void fluxmethod_advection_diffusion_3d_gpukernel(real *solution, real *solutiongradient, real *flux, real u, real v, real w, real nu, int ndof){ - uint32_t i = threadIdx.x + blockIdx.x*blockDim.x; - - if( i < ndof ){ - flux[i] = u*solution[i] - nu*solutiongradient[i]; - flux[i+ndof] = v*solution[i] - nu*solutiongradient[i+ndof]; - flux[i+2*ndof] = w*solution[i] - nu*solutiongradient[i+2*ndof]; - } - -} -extern "C" -{ - void fluxmethod_advection_diffusion_3d_gpu(real *solution, real *solutiongradient, real *flux, real u, real v, real w, real nu, int N, int nel, int nvar){ - int ndof = (N+1)*(N+1)*(N+1)*nel*nvar; - int threads_per_block = 256; - int nblocks_x = ndof/threads_per_block +1; - fluxmethod_advection_diffusion_3d_gpukernel<<>>(solution,solutiongradient,flux,u,v,w,nu,ndof); - } - -} - -__global__ void boundaryflux_advection_diffusion_3d_gpukernel(real *fb, real *fextb, real *dfavg, real *nhat, real *nscale, real *flux, real u, real v, real w, real nu, int N, int nel, int nvar){ - uint32_t idof = threadIdx.x + blockIdx.x*blockDim.x; - uint32_t ndof = (N+1)*(N+1)*6*nel; - - if( idof < ndof ){ - - uint32_t i = idof % (N+1); - uint32_t j = (idof/(N+1)) % (N+1); - uint32_t k = (idof/(N+1)/(N+1)) % 6; - uint32_t iel = idof/(N+1)/(N+1)/6; - uint32_t ivar = blockIdx.y; - - real nx = nhat[VEB_3D_INDEX(i,j,k,iel,0,0,N,nel,1)]; - real ny = nhat[VEB_3D_INDEX(i,j,k,iel,0,1,N,nel,1)]; - real nz = nhat[VEB_3D_INDEX(i,j,k,iel,0,2,N,nel,1)]; - - real un = u*nx+v*ny+w*nz; - - real dfdn = dfavg[VEB_3D_INDEX(i,j,k,iel,ivar,0,N,nel,nvar)]*nx+ - dfavg[VEB_3D_INDEX(i,j,k,iel,ivar,1,N,nel,nvar)]*ny+ - dfavg[VEB_3D_INDEX(i,j,k,iel,ivar,2,N,nel,nvar)]*nz; - - real nmag = nscale[SCB_3D_INDEX(i,j,k,iel,0,N,nel)]; - - flux[idof+ivar*ndof] = (0.5*(un*(fb[idof+ivar*ndof]+fextb[idof+ivar*ndof])+ - fabsf(un)*(fb[idof+ivar*ndof]-fextb[idof+ivar*ndof]))- - nu*dfdn)*nmag; - } - -} -extern "C" -{ - void boundaryflux_advection_diffusion_3d_gpu(real *fb, real *fextb, real *dfavg, real *nhat, real *nscale, real *flux, real u, real v, real w, real nu, int N, int nel, int nvar){ - int threads_per_block = 256; - uint32_t ndof = (N+1)*(N+1)*6*nel; - int nblocks_x = ndof/threads_per_block +1; - - dim3 nblocks(nblocks_x,nvar,1); - dim3 nthreads(threads_per_block,1,1); - - boundaryflux_advection_diffusion_3d_gpukernel<<>>(fb,fextb,dfavg,nhat,nscale,flux,u,v,w,nu,N,nel,nvar); - } - -} - diff --git a/src/gpu/SELF_advection_diffusion_3d.f90 b/src/gpu/SELF_advection_diffusion_3d.f90 deleted file mode 100644 index c470a12cd..000000000 --- a/src/gpu/SELF_advection_diffusion_3d.f90 +++ /dev/null @@ -1,135 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -module self_advection_diffusion_3d - - use self_advection_diffusion_3d_t - - implicit none - - type,extends(advection_diffusion_3d_t) :: advection_diffusion_3d - contains - procedure :: setboundarycondition => setboundarycondition_advection_diffusion_3d - procedure :: setgradientboundarycondition => setgradientboundarycondition_advection_diffusion_3d - procedure :: boundaryflux => boundaryflux_advection_diffusion_3d - procedure :: fluxmethod => fluxmethod_advection_diffusion_3d - - endtype advection_diffusion_3d - - interface - subroutine setboundarycondition_advection_diffusion_3d_gpu(extboundary,boundary,sideinfo,N,nel,nvar) & - bind(c,name="setboundarycondition_advection_diffusion_3d_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo - integer(c_int),value :: N,nel,nvar - endsubroutine setboundarycondition_advection_diffusion_3d_gpu - endinterface - - interface - subroutine setgradientboundarycondition_advection_diffusion_3d_gpu(extboundary,boundary,sideinfo,N,nel,nvar) & - bind(c,name="setgradientboundarycondition_advection_diffusion_3d_gpu") - use iso_c_binding - type(c_ptr),value :: extboundary,boundary,sideinfo - integer(c_int),value :: N,nel,nvar - endsubroutine setgradientboundarycondition_advection_diffusion_3d_gpu - endinterface - - interface - subroutine fluxmethod_advection_diffusion_3d_gpu(solution,solutiongradient,flux,u,v,w,nu,N,nel,nvar) & - bind(c,name="fluxmethod_advection_diffusion_3d_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: solution,solutiongradient,flux - real(c_prec),value :: u,v,w,nu - integer(c_int),value :: N,nel,nvar - endsubroutine fluxmethod_advection_diffusion_3d_gpu - endinterface - - interface - subroutine boundaryflux_advection_diffusion_3d_gpu(fb,fextb,dfavg,nhat,nscale,flux,u,v,w,nu,N,nel,nvar) & - bind(c,name="boundaryflux_advection_diffusion_3d_gpu") - use iso_c_binding - use SELF_Constants - type(c_ptr),value :: fb,fextb,dfavg,flux,nhat,nscale - real(c_prec),value :: u,v,w,nu - integer(c_int),value :: N,nel,nvar - endsubroutine boundaryflux_advection_diffusion_3d_gpu - endinterface - -contains - - subroutine setboundarycondition_advection_diffusion_3d(this) - !! Boundary conditions are set to periodic boundary conditions - implicit none - class(advection_diffusion_3d),intent(inout) :: this - - call setboundarycondition_advection_diffusion_3d_gpu(this%solution%extboundary_gpu, & - this%solution%boundary_gpu,this%mesh%sideInfo_gpu,this%solution%interp%N, & - this%solution%nelem,this%solution%nvar) - - endsubroutine setboundarycondition_advection_diffusion_3d - - subroutine setgradientboundarycondition_advection_diffusion_3d(this) - !! Gradient boundary conditions are set to periodic boundary conditions - implicit none - class(advection_diffusion_3d),intent(inout) :: this - - call setgradientboundarycondition_advection_diffusion_3d_gpu( & - this%solutiongradient%extboundary_gpu, & - this%solutiongradient%boundary_gpu,this%mesh%sideInfo_gpu, & - this%solution%interp%N,this%solution%nelem,this%solution%nvar) - - endsubroutine setgradientboundarycondition_advection_diffusion_3d - - subroutine fluxmethod_advection_diffusion_3d(this) - implicit none - class(advection_diffusion_3d),intent(inout) :: this - - call fluxmethod_advection_diffusion_3d_gpu(this%solution%interior_gpu, & - this%solutiongradient%interior_gpu,this%flux%interior_gpu, & - this%u,this%v,this%w,this%nu,this%solution%interp%N, & - this%solution%nelem, & - this%solution%nvar) - - endsubroutine fluxmethod_advection_diffusion_3d - - subroutine boundaryflux_advection_diffusion_3d(this) - ! this method uses an linear upwind solver for the - ! advective flux and the bassi-rebay method for the - ! diffusive fluxes - implicit none - class(advection_diffusion_3d),intent(inout) :: this - - call boundaryflux_advection_diffusion_3d_gpu(this%solution%boundary_gpu, & - this%solution%extBoundary_gpu,this%solutionGradient%avgBoundary_gpu, & - this%geometry%nhat%boundary_gpu,this%geometry%nscale%boundary_gpu, & - this%flux%boundarynormal_gpu,this%u,this%v,this%w, & - this%nu,this%solution%interp%N, & - this%solution%nelem,this%solution%nvar) - - endsubroutine boundaryflux_advection_diffusion_3d - -endmodule self_advection_diffusion_3d diff --git a/src/python/CMakeLists.txt b/src/python/CMakeLists.txt new file mode 100644 index 000000000..cb1738e75 --- /dev/null +++ b/src/python/CMakeLists.txt @@ -0,0 +1,63 @@ + +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +# +# Maintainers : support@fluidnumerics.com +# Official Repository : https://github.com/FluidNumerics/self/ +# +# Copyright © 2024 Fluid Numerics LLC +# +# Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: +# +# 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. +# +# 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in +# the documentation and/or other materials provided with the distribution. +# +# 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from +# this software without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +# HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +# +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +file(GLOB SELF_PYINT_FSRC "${CMAKE_CURRENT_SOURCE_DIR}/*.f*") + +# Enable pre-processing for source code +set_source_files_properties( + ${SELF_PYINT_FSRC} + PROPERTIES Fortran_PREPROCESS ON +) + +set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include) + +add_library(self_interface SHARED ${SELF_PYINT_FSRC}) +#set_target_properties(self PROPERTIES OUTPUT_NAME "self") +target_link_libraries(self_interface PUBLIC + self + ${FEQPARSE_LIBRARIES} + HDF5::HDF5 + ${MPI_Fortran_LIBRARIES} + ${BACKEND_LIBRARIES} + ${JSONFORTRAN_LIBRARIES}) + +target_include_directories(self_interface PUBLIC + ${FEQPARSE_INCLUDE_DIRS} + ${HDF5_INCLUDE_DIRS} + ${MPI_Fortran_INCLUDE_DIRS} + ${JSONFORTRAN_INCLUDE_DIRS}) + +target_compile_options(self_interface PUBLIC -fPIC) + +set_target_properties(self_interface PROPERTIES LINKER_LANGUAGE Fortran) + +install(TARGETS self_interface + ARCHIVE DESTINATION lib + LIBRARY DESTINATION lib + PUBLIC_HEADER DESTINATION include) + +install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ DESTINATION include) diff --git a/src/python/SELF_JSON_Config.f90 b/src/python/SELF_JSON_Config.f90 new file mode 100644 index 000000000..239d59586 --- /dev/null +++ b/src/python/SELF_JSON_Config.f90 @@ -0,0 +1,259 @@ +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! +! +! Maintainers : support@fluidnumerics.com +! Official Repository : https://github.com/FluidNumerics/self/ +! +! Copyright © 2024 Fluid Numerics LLC +! +! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in +! the documentation and/or other materials provided with the distribution. +! +! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from +! this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUsLESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARIsLG IN ANY WAY OUT OF THE USE OF +! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! + +module SELF_JSON_Config + + !USE SELF_Constants + !USE SELF_CLI + ! External Modules + use json_module + use iso_fortran_env + + implicit none + + integer,parameter :: SELF_FILE_DEFAULT_LENGTH = 500 + + type,public :: SELFConfig + !TYPE(JSON_FILE) :: schema + type(JSON_FILE) :: concretization + !CHARACTER(SELF_FILE_DEFAULT_LENGTH) :: schemaFile + + contains + + generic,public :: Init => Init_SELFConfig_FromFile !, Init_SELFConfig_FromCLI + procedure,private :: Init_SELFConfig_FromFile + !PROCEDURE, PRIVATE :: Init_SELFConfig_FromCLI + + !GENERIC, PUBLIC :: LoadSchema => LoadSchema_SELFConfig_FromFile + !PROCEDURE, PRIVATE :: LoadSchema_SELFConfig_FromFile + + generic,public :: LoadConcretization => LoadConcretization_SELFConfig_FromFile + procedure,private :: LoadConcretization_SELFConfig_FromFile + + procedure,public :: Free => Free_SELFConfig + + generic,public :: Get => Get_SELFConfig_int32, & + Get_SELFConfig_int64, & + Get_SELFConfig_real32, & + Get_SELFConfig_real64, & + Get_SELFConfig_logical, & + Get_SELFConfig_char + + procedure,private :: Get_SELFConfig_int32 + procedure,private :: Get_SELFConfig_int64 + procedure,private :: Get_SELFConfig_real32 + procedure,private :: Get_SELFConfig_real64 + procedure,private :: Get_SELFConfig_logical + procedure,private :: Get_SELFConfig_char + + endtype SELFConfig + + integer,parameter :: SELF_JSON_DEFAULT_KEY_LENGTH = 200 + integer,parameter :: SELF_JSON_DEFAULT_VALUE_LENGTH = 200 + +contains + + subroutine Init_SELFConfig_FromFile(this,concretizationFile) + implicit none + class(SELFConfig),intent(out) :: this + character(*),intent(in) :: concretizationFile + + !CALL this % LoadSchema( schemaFile ) + call this%LoadConcretization(concretizationFile) + + endsubroutine Init_SELFConfig_FromFile + +! SUBROUTINE Init_SELFConfig_FromCLI( this ) +! #undef __FUNC__ +! #define __FUNC__ "Init" +! IMPLICIT NONE +! CLASS(SELFConfig), INTENT(out) :: this +! ! Local +! CHARACTER(LEN=SELF_FILE_DEFAULT_LENGTH) :: concretizationFile +! CHARACTER(LEN=200) :: SELF_PREFIX +! LOGICAL :: fileExists + +! ! Set Default configuration file to +! ! ${SELF_PREFIX}/etc/schema/defaults/self.json +! CALL get_environment_variable("SELF_PREFIX", SELF_PREFIX) +! concretizationFile = TRIM(SELF_PREFIX)//"/etc/schema/defaults/self.json" + +! IF ( CommandLineArgumentIsPresent(argument = "-i") ) THEN +! concretizationFile = StringValueForArgument(argument = "-i") +! END IF +! INFO("Using configuration file : "//TRIM(concretizationFile)) +! INQUIRE(FILE=TRIM(concretizationFile), EXIST=fileExists ) +! IF( fileExists )THEN +! CALL this % LoadConcretization( TRIM(concretizationFile) ) +! ELSE +! ERROR("Configuration file does not exist : "//TRIM(concretizationFile)) +! STOP 1 +! ENDIF + +! END SUBROUTINE Init_SELFConfig_FromCLI + + ! SUBROUTINE LoadSchema_SELFConfig_FromFile( this, schemaFile ) + ! !! Loads schema from file and stores in schema attribute + ! IMPLICIT NONE + ! CLASS(SELFConfig), INTENT(out) :: this + ! CHARACTER(*), INTENT(in) :: schemaFile + + ! this % schemaFile = schemaFile + ! CALL this % schema % initialize(stop_on_error = .true., & + ! comment_char = '#') + + ! CALL this % schema % load_file(filename = TRIM(schemaFile)) + + ! CALL this % schema % print_file() + + ! END SUBROUTINE LoadSchema_SELFConfig_FromFile + + subroutine LoadConcretization_SELFConfig_FromFile(this,concretizationFile) + !! Loads a concretization and stores in concretization attributes + implicit none + class(SELFConfig),intent(out) :: this + character(*),intent(in) :: concretizationFile + + call this%concretization%initialize(stop_on_error=.true., & + comment_char='#') + + call this%concretization%load_file(filename=trim(concretizationFile)) + + endsubroutine LoadConcretization_SELFConfig_FromFile + + subroutine Free_SELFConfig(this) + !! Frees the attributes of the SELFConfig class and reset the config attribute + !! to an empty string + implicit none + class(SELFConfig),intent(inout) :: this + + !CALL this % schema % destroy() + call this%concretization%destroy() + ! this % schemaFile = "" + + endsubroutine Free_SELFConfig + + subroutine Get_SELFConfig_int32(this,jsonKey,res) + implicit none + class(SELFConfig),intent(inout) :: this + character(*),intent(in) :: jsonKey + integer(int32),intent(out) :: res + ! Local + logical :: found + + call this%concretization%get(trim(jsonKey),res,found) + if(.not. found) then + print*,"JSON key not found : "//trim(jsonKey) + stop 1 + endif + + endsubroutine Get_SELFConfig_int32 + + subroutine Get_SELFConfig_int64(this,jsonKey,res) + implicit none + class(SELFConfig),intent(inout) :: this + character(*),intent(in) :: jsonKey + integer(int64),intent(out) :: res + ! Local + logical :: found + integer(int32) :: res32 + + call this%concretization%get(trim(jsonKey),res32,found) + if(.not. found) then + print*,"JSON key not found : "//trim(jsonKey) + stop 1 + endif + res = int(res32,kind=int64) + + endsubroutine Get_SELFConfig_int64 + + subroutine Get_SELFConfig_real32(this,jsonKey,res) + implicit none + class(SELFConfig),intent(inout) :: this + character(*),intent(in) :: jsonKey + real(real32),intent(out) :: res + ! Local + logical :: found + + call this%concretization%get(trim(jsonKey),res,found) + if(.not. found) then + print*,"JSON key not found : "//trim(jsonKey) + stop 1 + endif + + endsubroutine Get_SELFConfig_real32 + + subroutine Get_SELFConfig_real64(this,jsonKey,res) + implicit none + class(SELFConfig),intent(inout) :: this + character(*),intent(in) :: jsonKey + real(real64),intent(out) :: res + ! Local + logical :: found + + call this%concretization%get(trim(jsonKey),res,found) + if(.not. found) then + print*,"JSON key not found : "//trim(jsonKey) + stop 1 + endif + + endsubroutine Get_SELFConfig_real64 + + subroutine Get_SELFConfig_logical(this,jsonKey,res) + implicit none + class(SELFConfig),intent(inout) :: this + character(*),intent(in) :: jsonKey + logical,intent(out) :: res + ! Local + logical :: found + + call this%concretization%get(trim(jsonKey),res,found) + if(.not. found) then + print*,"JSON key not found : "//trim(jsonKey) + stop 1 + endif + + endsubroutine Get_SELFConfig_logical + + subroutine Get_SELFConfig_char(this,jsonKey,res) + implicit none + class(SELFConfig),intent(inout) :: this + character(*),intent(in) :: jsonKey + character(*),intent(out) :: res + ! Local + logical :: found + character(LEN=:),allocatable :: resLoc + + call this%concretization%get(trim(jsonKey),resLoc,found) + if(.not. found) then + print*,"JSON key not found : "//trim(jsonKey) + stop 1 + endif + res = trim(resLoc) + + endsubroutine Get_SELFConfig_char + +endmodule SELF_JSON_Config diff --git a/src/python/SELF_LinearShallowWater2D_Interface.f90 b/src/python/SELF_LinearShallowWater2D_Interface.f90 new file mode 100644 index 000000000..1749630a0 --- /dev/null +++ b/src/python/SELF_LinearShallowWater2D_Interface.f90 @@ -0,0 +1,54 @@ +module SELF_LinearShallowWater2D_Interface +! Core + use SELF_Constants + use SELF_SupportRoutines + use SELF_Mesh + use SELF_Geometry_2D + use SELF_JSON_Config + +! Models + use self_LinearShallowWater2D + +! External + use iso_fortran_env + use iso_c_binding + +contains + + subroutine Init_LinearShallowWater2D(modelObj,geometry,mesh) + implicit none + type(LinearShallowWater2D),intent(inout) :: modelObj + type(SEMQuad),intent(in) :: geometry + type(Mesh2D),intent(in) :: mesh + + print*,"Model set to Linear Shallow Water (2D)" + + call modelObj%Init(mesh,geometry) + modelObj%prescribed_bcs_enabled = .false. ! Disables prescribed boundary condition block for gpu accelerated implementations + modelObj%tecplot_enabled = .false. ! Disables tecplot output + + endsubroutine Init_LinearShallowWater2D + + subroutine UpdateParameters_LinearShallowWater2D(modelObj,config) + implicit none + type(LinearShallowWater2D),intent(inout) :: modelObj + type(SELFConfig),intent(inout) :: config + + call config%Get("linear-shallow-water-2d.environment.g", & + modelObj%g) + + call config%Get("linear-shallow-water-2d.environment.H", & + modelObj%H) + + call config%Get("linear-shallow-water-2d.environment.Cd", & + modelObj%Cd) + + call config%Get("linear-shallow-water-2d.environment.f0", & + modelObj%f0) + + call config%Get("linear-shallow-water-2d.environment.beta", & + modelObj%beta) + + endsubroutine UpdateParameters_LinearShallowWater2D + +endmodule SELF_LinearShallowWater2D_Interface diff --git a/src/python/SELF_Model_Interface.f90 b/src/python/SELF_Model_Interface.f90 new file mode 100644 index 000000000..fdec49f0b --- /dev/null +++ b/src/python/SELF_Model_Interface.f90 @@ -0,0 +1,441 @@ + +module SELF_Model_Interface + + ! Core + use SELF_Constants + use SELF_SupportRoutines + use SELF_Metadata + + use SELF_Mesh + use SELF_Mesh_1D + use SELF_Mesh_2D + use SELF_Mesh_3D + + use SELF_Geometry + use SELF_Geometry_1D + use SELF_Geometry_2D + use SELF_Geometry_3D + + use SELF_JSON_Config + + ! Models + use SELF_Model + use SELF_DGModel1D + use SELF_DGModel2D + use SELF_DGModel3D + + use SELF_Burgers1D + !use SELF_Burgers1D_Interface + + use SELF_LinearShallowWater2D + use SELF_LinearShallowWater2D_Interface + + use SELF_LinearEuler2D + !use SELF_LinearEuler2D_Interface + + use SELF_LinearEuler3D + !use SELF_LinearEuler3D_Interface + + ! External + use iso_fortran_env + use iso_c_binding + + implicit none + + type(SELFConfig) :: config + type(Lagrange),target,private :: interp + !type(MPILayer),target :: decomp + + ! ========================================== ! + ! Top level pointers ! + ! ========================================== ! + class(Model),pointer,private :: selfModel + class(SEMMesh),pointer,private :: selfMesh + class(SEMGeometry),pointer,private :: selfGeometry + + ! Mesh + type(Mesh1D),target,private :: selfMesh1D + type(Mesh2D),target,private :: selfMesh2D + type(Mesh3D),target,private :: selfMesh3D + + ! Geometry + type(Geometry1D),target,private :: selfGeometry1D + type(SEMQuad),target,private :: selfGeometry2D + type(SEMHex),target,private :: selfGeometry3D + + ! Models + type(Burgers1D),target,private :: selfBurgers1D + type(LinearShallowWater2D),target,private :: selfLinearShallowWater2D + type(LinearEuler2D),target,private :: selfLinearEuler2D + type(LinearEuler3D),target,private :: selfLinearEuler3D + + integer,parameter,private :: MODEL_NAME_LENGTH = 50 + + character(kind=c_char,len=750),private :: model_configuration_file + + ! Interfaces + public :: Initialize + public :: ForwardStep + public :: WritePickupFile + public :: UpdateParameters + public :: GetSolution + public :: SetSolution + public :: GetPrecision + public :: GetVariableName + public :: GetVariableUnits + public :: Finalize + private :: GetBCFlagForChar,Init2DWorkspace +contains + + ! ================================================================= + ! Public methods + ! ================================================================= + + function Initialize(config_file) result(error) bind(C,name="Initialize") + implicit none + character(kind=c_char,len=*),intent(in) :: config_file + integer(c_int) :: error + ! local + character(len=MODEL_NAME_LENGTH) :: modelname + + call config%Init(config_file) + model_configuration_file = config_file + + call config%Get("model_name",modelname) + + ! Select the model + select case(trim(modelname)) + + case("burgers-1d") + + print*,"Not implemented yet" + error = -1 + ! call Init1DWorkspace() + ! call Init_Burgers1D(selfBurgers1D,selfGeometry1D,selfMesh1D) + ! selfModel => selfBurgers1D + ! error = 0 + + case("linear-shallow-water-2d") + + call Init2DWorkspace() + call Init_LinearShallowWater2D(selfLinearShallowWater2D,selfGeometry2D,selfMesh2D) + selfModel => selfLinearShallowWater2D + error = 0 + + case("linear-euler-2d") + + print*,"Not implemented yet" + error = -1 + ! call Init2DWorkspace() + ! call Init_LinearEuler2D(selfLinearEuler2D,selfGeometry2D,selfMesh2D) + ! selfModel => selfLinearEuler2D + ! error = 0 + + case("linear-euler-3d") + + print*,"Not implemented yet" + error = -1 + ! call Init2DWorkspace() + ! call Init_LinearEuler2D(selfLinearEuler2D,selfGeometry2D,selfMesh2D) + ! selfModel => selfLinearEuler2D + ! error = 0 + + case("gfdles-3d") + + print*,"Not implemented yet" + error = -1 + ! call Init2DWorkspace() + ! call Init_LinearEuler2D(selfLinearEuler2D,selfGeometry2D,selfMesh2D) + ! selfModel => selfLinearEuler2D + ! error = 0 + + case default + + endselect + + ! Point the mesh and geometry top level pointers to the appropriate mesh and geometry objects + select type(selfModel) + + class is(DGModel1D) + selfMesh => selfMesh1D + selfGeometry => selfGeometry1D + + class is(DGModel2D) + selfMesh => selfMesh2D + selfGeometry => selfGeometry2D + + class is(DGModel3D) + selfMesh => selfMesh3D + selfGeometry => selfGeometry3D + + endselect + + call UpdateParameters() + + endfunction Initialize + + subroutine Finalize() bind(C,name="Finalize") + implicit none + + call config%Free() + call selfModel%Free() + call selfMesh%Free() + call selfGeometry%Free() + call interp%Free() + + ! Nullify the top level pointers + selfModel => null() + selfMesh => null() + selfGeometry => null() + + endsubroutine Finalize + + subroutine WritePickupFile(case_directory,pickupFile) bind(C,name="WritePickupFile") + implicit none + character(kind=c_char,len=*),intent(in) :: case_directory + character(kind=c_char,len=*),intent(out) :: pickupFile + ! Local + character(13) :: timeStampString + + write(timeStampString,'(I13.13)') selfModel%ioIterate + pickupFile = trim(case_directory)//'/solution.'//timeStampString//'.h5' + call selfModel%WriteModel(trim(pickupfile)) + + endsubroutine WritePickupFile + + subroutine UpdateParameters() bind(c,name="UpdateParameters") + implicit none + character(len=self_IntegratorTypeCharLength) :: timeIntegrator + + call config%Free() + call config%Init(model_configuration_file) + + ! Set the time integrator + call config%Get("time_options.integrator",timeIntegrator) + call selfModel%SetTimeIntegrator(trim(timeIntegrator)) + + select type(selfModel) + + type is(Burgers1D) + print*,"Not implemented yet" + !call UpdateParameters_Burgers1D(selfModel,config) + type is(LinearShallowWater2D) + + call UpdateParameters_LinearShallowWater2D(selfModel,config) + + endselect + + endsubroutine UpdateParameters + + function ForwardStep(dt,updateInterval) result(err) bind(c,name="ForwardStep") + implicit none + real(c_prec) :: dt + real(c_prec) :: updateInterval + integer(c_int) :: err + ! Local + real(prec) :: targetTime + + selfModel%dt = real(dt,prec) + targetTime = selfModel%t+selfModel%dt*real(updateInterval,prec) + call selfModel%timeIntegrator(targetTime) + selfModel%t = targetTime + + ! To do, check solution validity + err = 0 + + endfunction ForwardStep + + function GetPrecision() result(precision) bind(c,name="GetPrecision") + integer(c_int) :: precision + + precision = prec + + endfunction GetPrecision + + subroutine GetSolution(solution,solshape,ndim) bind(C,name="GetSolution") + type(c_ptr),intent(out) :: solution ! Pointer to data + integer(c_int),intent(out) :: solshape(5) ! Shape array (max 4D) + integer(c_int),intent(out) :: ndim ! Number of dimensions (3, 4, 5) + + select type(selfModel) + + class is(DGModel1D) + solshape(1:3) = shape(selfModel%solution%interior) + solshape(4:5) = 0 + ndim = 3 + call selfModel%solution%UpdateHost() + solution = c_loc(selfModel%solution%interior) + + class is(DGModel2D) + solshape(1:4) = shape(selfModel%solution%interior) + solshape(5) = 0 + ndim = 4 + call selfModel%solution%UpdateHost() + solution = c_loc(selfModel%solution%interior) + + class is(DGModel3D) + solshape(1:5) = shape(selfModel%solution%interior) + ndim = 5 + call selfModel%solution%UpdateHost() + solution = c_loc(selfModel%solution%interior) + + endselect + + endsubroutine GetSolution + + subroutine SetSolution(solution,solshape) bind(C,name="SetSolution") + type(c_ptr),intent(in) :: solution ! Pointer to data + integer(c_int),intent(in) :: solshape(5) ! Shape array (max 4D) + + select type(selfModel) + + class is(DGModel1D) + call c_f_pointer(solution,selfModel%solution%interior,solshape(1:3)) + call selfModel%solution%UpdateDevice() + + class is(DGModel2D) + call c_f_pointer(solution,selfModel%solution%interior,solshape(1:4)) + call selfModel%solution%UpdateDevice() + + class is(DGModel3D) + call c_f_pointer(solution,selfModel%solution%interior,solshape(1:5)) + call selfModel%solution%UpdateDevice() + + endselect + + endsubroutine SetSolution + + subroutine GetVariableName(ivar,name) bind(c,name="GetVariableName") + integer(c_int),intent(in) :: ivar + character(kind=c_char,len=*),intent(out) :: name + + select type(selfModel) + + class is(DGModel1D) + name = selfModel%solution%meta(ivar)%name + + class is(DGModel2D) + name = selfModel%solution%meta(ivar)%name + + class is(DGModel3D) + name = selfModel%solution%meta(ivar)%name + + endselect + + endsubroutine GetVariableName + + subroutine GetVariableUnits(ivar,name) bind(c,name="GetVariableUnits") + integer(c_int),intent(in) :: ivar + character(kind=c_char,len=*),intent(out) :: name + + select type(selfModel) + + class is(DGModel1D) + name = selfModel%solution%meta(ivar)%units + + class is(DGModel2D) + name = selfModel%solution%meta(ivar)%units + + class is(DGModel3D) + name = selfModel%solution%meta(ivar)%units + + endselect + + endsubroutine GetVariableUnits + + ! ================================================================= + ! Private methods + ! ================================================================= + + function GetBCFlagForChar(charFlag) result(intFlag) + !! This method is used to return the integer flag from a char for boundary conditions + !! + implicit none + character(*),intent(in) :: charFlag + integer :: intFlag + + select case(UpperCase(trim(charFlag))) + + case("PRESCRIBED") + intFlag = SELF_BC_PRESCRIBED + + case("RADIATION") + intFlag = SELF_BC_RADIATION + + case("NO_NORMAL_FLOW") + intFlag = SELF_BC_NONORMALFLOW + + case DEFAULT + intFlag = 0 + + endselect + + endfunction GetBCFlagForChar + + function GetQFlagForChar(charFlag) result(intFlag) + !! This method is used to return the integer flag from a char for boundary conditions + !! + implicit none + character(*),intent(in) :: charFlag + integer :: intFlag + + select case(UpperCase(trim(charFlag))) + + case("GAUSS") + intFlag = GAUSS + + case("GAUSS-LOBATTO") + intFlag = GAUSS_LOBATTO + + case DEFAULT + intFlag = 0 + + endselect + + endfunction GetQFlagForChar + + subroutine Init2DWorkspace() + implicit none + ! Local + logical :: mpiRequested + character(len=self_QuadratureTypeCharLength) :: qChar + character(len=MODEL_NAME_LENGTH) :: meshfile + character(len=MODEL_NAME_LENGTH) :: uniformBoundaryCondition + integer :: controlQuadrature + integer :: controlDegree + integer :: targetDegree + integer :: targetQuadrature + integer :: bcFlag + + call config%Get("geometry.control_degree",controlDegree) + call config%Get("geometry.target_degree",targetDegree) + call config%Get("geometry.control_quadrature",qChar) + controlQuadrature = GetQFlagForChar(trim(qChar)) + call config%Get("geometry.target_quadrature",qChar) + targetQuadrature = GetQFlagForChar(trim(qChar)) + call config%Get("geometry.mesh_file",meshfile) + call config%Get("geometry.uniform_boundary_condition",uniformBoundaryCondition) + bcFlag = GetBCFlagForChar(uniformBoundaryCondition) + + print*,"Using Mesh file : "//trim(meshfile) + ! Read in mesh file and set the public mesh pointer to selfMesh2D + call selfMesh2D%Read_HOPr(trim(meshfile)) + call selfMesh2D%ResetBoundaryConditionType(bcFlag) + + selfMesh => selfMesh2D + + ! Create an interpolant + call interp%Init(controlDegree, & + controlQuadrature, & + targetDegree, & + targetQuadrature) + + ! Generate geometry (metric terms) from the mesh elements + call selfGeometry2D%Init(interp,selfMesh2D%nElem) + call selfGeometry2D%GenerateFromMesh(selfMesh2D) + +! selfGeometry => selfGeometry2D + + endsubroutine Init2DWorkspace + +endmodule SELF_Model_Interface diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index ea5a18e9f..6bfd5969a 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -1,28 +1,28 @@ -# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -# +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +# # Maintainers : support@fluidnumerics.com # Official Repository : https://github.com/FluidNumerics/self/ -# +# # Copyright © 2024 Fluid Numerics LLC -# +# # Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -# +# # 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -# +# # 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in # the documentation and/or other materials provided with the distribution. -# +# # 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from # this software without specific prior written permission. -# +# # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT # HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -# -# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +# +# //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// CMAKE_MINIMUM_REQUIRED(VERSION 3.21) @@ -118,9 +118,7 @@ add_fortran_tests ( "advection_diffusion_1d_rk3.f90" "advection_diffusion_1d_rk4.f90" "burgers1d_constant.f90" - "burgers1d_nonormalflow.f90" "burgers1d_prescribed.f90" - "burgers1d_radiation.f90" "advection_diffusion_2d_euler.f90" "advection_diffusion_2d_rk2.f90" "advection_diffusion_2d_rk3.f90" @@ -146,4 +144,4 @@ add_mpi_fortran_tests( "mappedvectordgdivergence_2d_linear_mpi.f90" "advection_diffusion_2d_rk3_mpi.f90" "advection_diffusion_2d_rk3_pickup_mpi.f90" "advection_diffusion_3d_rk3_mpi.f90" - "advection_diffusion_3d_rk3_pickup_mpi.f90" ) \ No newline at end of file + "advection_diffusion_3d_rk3_pickup_mpi.f90" ) diff --git a/test/advection_diffusion_1d_euler.f90 b/test/advection_diffusion_1d_euler.f90 deleted file mode 100644 index 2bdceba42..000000000 --- a/test/advection_diffusion_1d_euler.f90 +++ /dev/null @@ -1,114 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_1d_euler - - use self_data - use self_advection_diffusion_1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 1.0_prec ! velocity - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - ! Set the velocity - modelobj%u = u - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - call modelobj%WriteModel("advdiff1d-euler.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_1d_euler diff --git a/test/advection_diffusion_1d_euler_pickup.f90 b/test/advection_diffusion_1d_euler_pickup.f90 deleted file mode 100644 index bcf1531fe..000000000 --- a/test/advection_diffusion_1d_euler_pickup.f90 +++ /dev/null @@ -1,111 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_1d_euler - - use self_data - use self_advection_diffusion_1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 1.0_prec ! velocity - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - ! Set the velocity - modelobj%u = u - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition from a pickup file - call modelobj%ReadModel("advdiff1d-euler.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_1d_euler diff --git a/test/advection_diffusion_1d_rk2.f90 b/test/advection_diffusion_1d_rk2.f90 deleted file mode 100644 index f2109404e..000000000 --- a/test/advection_diffusion_1d_rk2.f90 +++ /dev/null @@ -1,108 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_1d_rk2 - - use self_data - use self_advection_diffusion_1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk2' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 1.0_prec ! velocity - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.01_prec - real(prec),parameter :: iointerval = 0.01_prec - integer,parameter :: stepsperio = 1000 - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - ! Set the velocity - modelobj%u = u - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_1d_rk2 diff --git a/test/advection_diffusion_1d_rk3.f90 b/test/advection_diffusion_1d_rk3.f90 deleted file mode 100644 index c94380f65..000000000 --- a/test/advection_diffusion_1d_rk3.f90 +++ /dev/null @@ -1,110 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_1d_rk3 - - use self_data - use self_advection_diffusion_1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 1.0_prec ! velocity - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - ! Set the velocity - modelobj%u = u - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_1d_rk3 diff --git a/test/advection_diffusion_1d_rk4.f90 b/test/advection_diffusion_1d_rk4.f90 deleted file mode 100644 index e86be5dc9..000000000 --- a/test/advection_diffusion_1d_rk4.f90 +++ /dev/null @@ -1,107 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_1d_rk4 - - use self_data - use self_advection_diffusion_1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk4' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 1.0_prec ! velocity - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.01_prec - real(prec),parameter :: iointerval = 0.01_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - ! Set the velocity - modelobj%u = u - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_1d_rk4 diff --git a/test/advection_diffusion_2d_euler.f90 b/test/advection_diffusion_2d_euler.f90 deleted file mode 100644 index 1e3481874..000000000 --- a/test/advection_diffusion_2d_euler.f90 +++ /dev/null @@ -1,115 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_euler - - use self_data - use self_advection_diffusion_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: nu = 0.005_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_2d) :: modelobj - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! We create a domain decomposition. - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - call modelobj%CalculateTendency() - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_2d_euler diff --git a/test/advection_diffusion_2d_rk2.f90 b/test/advection_diffusion_2d_rk2.f90 deleted file mode 100644 index 5c2783c03..000000000 --- a/test/advection_diffusion_2d_rk2.f90 +++ /dev/null @@ -1,106 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_rk2 - - use self_data - use self_advection_diffusion_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk2' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: nu = 0.005_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_2d) :: modelobj - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = maxval(abs(modelobj%solution%interior)) - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = maxval(abs(modelobj%solution%interior)) - - if(ef > e0) then - print*,"Error: Final absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_2d_rk2 diff --git a/test/advection_diffusion_2d_rk3.f90 b/test/advection_diffusion_2d_rk3.f90 deleted file mode 100644 index db061bcbf..000000000 --- a/test/advection_diffusion_2d_rk3.f90 +++ /dev/null @@ -1,107 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_rk3 - - use self_data - use self_advection_diffusion_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: nu = 0.005_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_2d) :: modelobj - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - call modelobj%WriteModel("advdiff2d-rk3.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_2d_rk3 diff --git a/test/advection_diffusion_2d_rk3_mpi.f90 b/test/advection_diffusion_2d_rk3_mpi.f90 deleted file mode 100644 index 5fa72b177..000000000 --- a/test/advection_diffusion_2d_rk3_mpi.f90 +++ /dev/null @@ -1,107 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_rk3 - - use self_data - use self_advection_diffusion_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: nu = 0.005_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_2d) :: modelobj - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - call modelobj%WriteModel("advdiff2d-rk3-mpi.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_2d_rk3 diff --git a/test/advection_diffusion_2d_rk3_pickup.f90 b/test/advection_diffusion_2d_rk3_pickup.f90 deleted file mode 100644 index 2e22e1ad1..000000000 --- a/test/advection_diffusion_2d_rk3_pickup.f90 +++ /dev/null @@ -1,105 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_rk3 - - use self_data - use self_advection_diffusion_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: nu = 0.005_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_2d) :: modelobj - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition from pickup file - call modelobj%ReadModel("advdiff2d-rk3.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_2d_rk3 diff --git a/test/advection_diffusion_2d_rk3_pickup_mpi.f90 b/test/advection_diffusion_2d_rk3_pickup_mpi.f90 deleted file mode 100644 index 6f830bd39..000000000 --- a/test/advection_diffusion_2d_rk3_pickup_mpi.f90 +++ /dev/null @@ -1,105 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_rk3 - - use self_data - use self_advection_diffusion_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: nu = 0.005_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_2d) :: modelobj - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition from pickup file - call modelobj%ReadModel("advdiff2d-rk3-mpi.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_2d_rk3 diff --git a/test/advection_diffusion_2d_rk4.f90 b/test/advection_diffusion_2d_rk4.f90 deleted file mode 100644 index 3b01f3dd4..000000000 --- a/test/advection_diffusion_2d_rk4.f90 +++ /dev/null @@ -1,106 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_2d_rk4 - - use self_data - use self_advection_diffusion_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk4' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: nu = 0.005_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(advection_diffusion_2d) :: modelobj - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block2D/Block2D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = maxval(abs(modelobj%solution%interior)) - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = maxval(abs(modelobj%solution%interior)) - - if(ef > e0) then - print*,"Error: Final absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_2d_rk4 diff --git a/test/advection_diffusion_3d_euler.f90 b/test/advection_diffusion_3d_euler.f90 deleted file mode 100644 index b87f98d51..000000000 --- a/test/advection_diffusion_3d_euler.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_3d_euler - - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: w = 0.25_prec - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.01_prec - real(prec),parameter :: iointerval = 0.01_prec - type(advection_diffusion_3d) :: modelobj - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - modelobj%w = w - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 + (z-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_3d_euler diff --git a/test/advection_diffusion_3d_rk2.f90 b/test/advection_diffusion_3d_rk2.f90 deleted file mode 100644 index edc6b92c5..000000000 --- a/test/advection_diffusion_3d_rk2.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_3d_rk2 - - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk2' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: w = 0.25_prec - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.01_prec - real(prec),parameter :: iointerval = 0.01_prec - type(advection_diffusion_3d) :: modelobj - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - modelobj%w = w - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 + (z-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_3d_rk2 diff --git a/test/advection_diffusion_3d_rk3.f90 b/test/advection_diffusion_3d_rk3.f90 deleted file mode 100644 index d35c98754..000000000 --- a/test/advection_diffusion_3d_rk3.f90 +++ /dev/null @@ -1,111 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_3d_rk3 - - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: w = 0.25_prec - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.01_prec - real(prec),parameter :: iointerval = 0.01_prec - type(advection_diffusion_3d) :: modelobj - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - character(LEN=255) :: WORKSPACE - real(prec) :: e0,ef - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - modelobj%w = w - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 + (z-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - call modelobj%WriteModel("advdiff3d-rk3.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_3d_rk3 diff --git a/test/advection_diffusion_3d_rk3_mpi.f90 b/test/advection_diffusion_3d_rk3_mpi.f90 deleted file mode 100644 index 22479518b..000000000 --- a/test/advection_diffusion_3d_rk3_mpi.f90 +++ /dev/null @@ -1,111 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_3d_rk3 - - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: w = 0.25_prec - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.01_prec - real(prec),parameter :: iointerval = 0.01_prec - type(advection_diffusion_3d) :: modelobj - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - character(LEN=255) :: WORKSPACE - real(prec) :: e0,ef - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - modelobj%w = w - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 + (z-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - call modelobj%WriteModel("advdiff3d-rk3-mpi.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_3d_rk3 diff --git a/test/advection_diffusion_3d_rk3_pickup.f90 b/test/advection_diffusion_3d_rk3_pickup.f90 deleted file mode 100644 index 41789dc36..000000000 --- a/test/advection_diffusion_3d_rk3_pickup.f90 +++ /dev/null @@ -1,109 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_3d_rk3 - - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: w = 0.25_prec - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.01_prec - real(prec),parameter :: iointerval = 0.01_prec - type(advection_diffusion_3d) :: modelobj - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - character(LEN=255) :: WORKSPACE - real(prec) :: e0,ef - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - modelobj%w = w - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition from pickup file - call modelobj%ReadModel("advdiff3d-rk3.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_3d_rk3 diff --git a/test/advection_diffusion_3d_rk3_pickup_mpi.f90 b/test/advection_diffusion_3d_rk3_pickup_mpi.f90 deleted file mode 100644 index 479a070a8..000000000 --- a/test/advection_diffusion_3d_rk3_pickup_mpi.f90 +++ /dev/null @@ -1,109 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_3d_rk3 - - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: w = 0.25_prec - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.01_prec - real(prec),parameter :: iointerval = 0.01_prec - type(advection_diffusion_3d) :: modelobj - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - character(LEN=255) :: WORKSPACE - real(prec) :: e0,ef - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - modelobj%w = w - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition from pickup file - call modelobj%ReadModel("advdiff3d-rk3-mpi.pickup.h5") - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_3d_rk3 diff --git a/test/advection_diffusion_3d_rk4.f90 b/test/advection_diffusion_3d_rk4.f90 deleted file mode 100644 index 6bd7ef436..000000000 --- a/test/advection_diffusion_3d_rk4.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program advection_diffusion_3d_rk4 - - use self_data - use self_advection_diffusion_3d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk4' - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: u = 0.25_prec ! velocity - real(prec),parameter :: v = 0.25_prec - real(prec),parameter :: w = 0.25_prec - real(prec),parameter :: nu = 0.001_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.01_prec - real(prec),parameter :: iointerval = 0.01_prec - type(advection_diffusion_3d) :: modelobj - type(Lagrange),target :: interp - type(Mesh3D),target :: mesh - type(SEMHex),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Create a uniform block mesh - call get_environment_variable("WORKSPACE",WORKSPACE) - call mesh%Read_HOPr(trim(WORKSPACE)//"/share/mesh/Block3D/Block3D_mesh.h5") - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the velocity - modelobj%u = u - modelobj%v = v - modelobj%w = w - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = exp( -( (x-0.5)^2 + (y-0.5)^2 + (z-0.5)^2 )/0.005 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram advection_diffusion_3d_rk4 diff --git a/test/burgers1d_constant.f90 b/test/burgers1d_constant.f90 deleted file mode 100644 index 3cc5886f3..000000000 --- a/test/burgers1d_constant.f90 +++ /dev/null @@ -1,109 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program burgers1d_constant - - use self_data - use self_burgers1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: nu = 0.01_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-5) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(burgers1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 1.0') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram burgers1d_constant diff --git a/test/burgers1d_nonormalflow.f90 b/test/burgers1d_nonormalflow.f90 deleted file mode 100644 index ec41c05e5..000000000 --- a/test/burgers1d_nonormalflow.f90 +++ /dev/null @@ -1,110 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program burgers1d_constant - - use self_data - use self_burgers1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: nu = 0.01_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-5) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(burgers1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - call mesh%ResetBoundaryConditionType(SELF_BC_NONORMALFLOW,SELF_BC_NONORMALFLOW) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 1.0') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram burgers1d_constant diff --git a/test/burgers1d_prescribed.f90 b/test/burgers1d_prescribed.f90 deleted file mode 100644 index ef91b4f0b..000000000 --- a/test/burgers1d_prescribed.f90 +++ /dev/null @@ -1,109 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program burgers1d_constant - - use self_data - use self_burgers1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: nu = 0.01_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-5) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(burgers1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - call mesh%ResetBoundaryConditionType(SELF_BC_PRESCRIBED,SELF_BC_PRESCRIBED) - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 1.0') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram burgers1d_constant diff --git a/test/burgers1d_radiation.f90 b/test/burgers1d_radiation.f90 deleted file mode 100644 index 9e2393cff..000000000 --- a/test/burgers1d_radiation.f90 +++ /dev/null @@ -1,110 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program burgers1d_constant - - use self_data - use self_burgers1d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'euler' - integer,parameter :: nelem = 50 - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: nu = 0.01_prec ! diffusivity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-5) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(burgers1d) :: modelobj - type(Lagrange),target :: interp - type(Mesh1D),target :: mesh - type(Geometry1D),target :: geometry - - ! Create a mesh using the built-in - ! uniform mesh generator. - ! The domain is set to x in [0,1] - ! We use `nelem` elements - call mesh%StructuredMesh(nElem=nelem, & - x=(/0.0_prec,1.0_prec/)) - call mesh%ResetBoundaryConditionType(SELF_BC_RADIATION,SELF_BC_RADIATION) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - !Set the diffusivity - modelobj%nu = nu - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 1.0') - call modelobj%solution%SetInteriorFromEquation(0.0_prec) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - call modelobj%ReportEntropy() - e0 = modelobj%entropy ! Save the initial entropy - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram burgers1d_constant diff --git a/test/linear_shallow_water_2d_constant.f90 b/test/linear_shallow_water_2d_constant.f90 deleted file mode 100644 index 5f896748c..000000000 --- a/test/linear_shallow_water_2d_constant.f90 +++ /dev/null @@ -1,118 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program LinearShallowWater2D_constant - use self_data - use self_LinearShallowWater2D - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: H = 1.0_prec ! uniform resting depth - real(prec),parameter :: g = 9.8_prec ! acceleration due to gravity - real(prec),parameter :: dt = 1.0_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(LinearShallowWater2D) :: modelobj - type(Lagrange),target :: interp - type(Mesh2D),target :: mesh - integer :: bcids(1:4) - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Set boundary conditions - bcids(1:4) = [SELF_BC_PRESCRIBED, & ! South - SELF_BC_PRESCRIBED, & ! East - SELF_BC_PRESCRIBED, & ! North - SELF_BC_PRESCRIBED] ! West - - ! Create a uniform block mesh - call mesh%StructuredMesh(5,5,2,2,0.1_prec,0.1_prec,bcids) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - modelobj%gradient_enabled = .true. - - ! Set the resting surface height and gravity - modelobj%H = H - modelobj%g = g - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 1.0') - call modelobj%solution%SetEquation(2,'f = 1.0') - call modelobj%solution%SetEquation(3,'f = 1.0') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - call modelobj%CalculateTendency() - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - call modelobj%CalculateEntropy() - e0 = modelobj%entropy - - !Write the initial condition - call modelobj%WriteModel() - call modelobj%WriteTecplot() - call modelobj%IncrementIOCounter() - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - print*,"min, max (interior)", & - minval(modelobj%solution%interior), & - maxval(modelobj%solution%interior) - - ef = modelobj%entropy - - if(ef > e0) then - print*,"Error: Final absmax greater than initial absmax! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram LinearShallowWater2D_constant diff --git a/test/linear_shallow_water_2d_nonormalflow.f90 b/test/linear_shallow_water_2d_nonormalflow.f90 deleted file mode 100644 index e25e7020c..000000000 --- a/test/linear_shallow_water_2d_nonormalflow.f90 +++ /dev/null @@ -1,105 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program LinearShallowWater2D_nonormalflow - use self_data - use self_LinearShallowWater2D - use self_mesh_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: H = 1.0_prec ! uniform resting depth - real(prec),parameter :: g = 1.0_prec ! acceleration due to gravity - real(prec),parameter :: dt = 0.5_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(LinearShallowWater2D) :: modelobj - type(Lagrange),target :: interp - integer :: bcids(1:4) - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Set no normal flow boundary conditions - bcids(1:4) = [SELF_BC_NONORMALFLOW, & ! South - SELF_BC_NONORMALFLOW, & ! East - SELF_BC_NONORMALFLOW, & ! North - SELF_BC_NONORMALFLOW] ! West - - ! Create a uniform block mesh - call mesh%StructuredMesh(5,5,2,2,0.1_prec,0.1_prec,bcids) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - - ! Set the resting surface height and gravity - modelobj%H = H - modelobj%g = g - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 0') - call modelobj%solution%SetEquation(2,'f = 0') - call modelobj%solution%SetEquation(3,'f = 0.001*exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - call modelobj%CalculateEntropy() - e0 = modelobj%entropy - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - ef = modelobj%entropy - - if(ef > e0) then - ! print*,"Final entropy not a finite number.",e0,ef - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram LinearShallowWater2D_nonormalflow diff --git a/test/linear_shallow_water_2d_radiation.f90 b/test/linear_shallow_water_2d_radiation.f90 deleted file mode 100644 index d037181a5..000000000 --- a/test/linear_shallow_water_2d_radiation.f90 +++ /dev/null @@ -1,105 +0,0 @@ -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! -! -! Maintainers : support@fluidnumerics.com -! Official Repository : https://github.com/FluidNumerics/self/ -! -! Copyright © 2024 Fluid Numerics LLC -! -! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in -! the documentation and/or other materials provided with the distribution. -! -! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -! THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! - -program LinearShallowWater2D_nonormalflow - use self_data - use self_LinearShallowWater2D - use self_mesh_2d - - implicit none - character(SELF_INTEGRATOR_LENGTH),parameter :: integrator = 'rk3' - - integer,parameter :: controlDegree = 7 - integer,parameter :: targetDegree = 16 - real(prec),parameter :: H = 1.0_prec ! uniform resting depth - real(prec),parameter :: g = 1.0_prec ! acceleration due to gravity - real(prec),parameter :: dt = 0.5_prec*10.0_prec**(-4) ! time-step size - real(prec),parameter :: endtime = 0.2_prec - real(prec),parameter :: iointerval = 0.1_prec - real(prec) :: e0,ef ! Initial and final entropy - type(LinearShallowWater2D) :: modelobj - type(Lagrange),target :: interp - integer :: bcids(1:4) - type(Mesh2D),target :: mesh - type(SEMQuad),target :: geometry - character(LEN=255) :: WORKSPACE - - ! Set radiation boundary conditions - bcids(1:4) = [SELF_BC_RADIATION, & ! South - SELF_BC_RADIATION, & ! East - SELF_BC_RADIATION, & ! North - SELF_BC_RADIATION] ! West - - ! Create a uniform block mesh - call mesh%StructuredMesh(5,5,2,2,0.1_prec,0.1_prec,bcids) - - ! Create an interpolant - call interp%Init(N=controlDegree, & - controlNodeType=GAUSS, & - M=targetDegree, & - targetNodeType=UNIFORM) - - ! Generate geometry (metric terms) from the mesh elements - call geometry%Init(interp,mesh%nElem) - call geometry%GenerateFromMesh(mesh) - - ! Initialize the model - call modelobj%Init(mesh,geometry) - - ! Set the resting surface height and gravity - modelobj%H = H - modelobj%g = g - - ! Set the initial condition - call modelobj%solution%SetEquation(1,'f = 0') - call modelobj%solution%SetEquation(2,'f = 0') - call modelobj%solution%SetEquation(3,'f = 0.001*exp( -( (x-0.5)^2 + (y-0.5)^2 )/0.01 )') - call modelobj%solution%SetInteriorFromEquation(geometry,0.0_prec) - - call modelobj%CalculateEntropy() - e0 = modelobj%entropy - - ! Set the model's time integration method - call modelobj%SetTimeIntegrator(integrator) - - ! forward step the model to `endtime` using a time step - ! of `dt` and outputing model data every `iointerval` - call modelobj%ForwardStep(endtime,dt,iointerval) - - ef = modelobj%entropy - - if(ef > e0) then - ! print*,"Final entropy not a finite number.",e0,ef - print*,"Error: Final entropy greater than initial entropy! ",e0,ef - stop 1 - endif - ! Clean up - call modelobj%free() - call mesh%free() - call geometry%free() - call interp%free() - -endprogram LinearShallowWater2D_nonormalflow