! Copyright (c) 2019 Kannan Masilamani <kannan.masilamani@uni-siegen.de> ! Copyright (c) 2019-2020 Harald Klimach <harald.klimach@uni-siegen.de> ! ! 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. ! ! 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. ! ****************************************************************************** !> summary: This module contains cube definitions and routine to load !! cube table from config file ! ****************************************************************************** module tem_cube_module use env_module, only: rk, long_k, labelLen use tem_logging_module, only: logunit use tem_geometry_module, only: tem_originOfId, tem_endOfId, tem_ElemSize use treelmesh_module, only: treelmesh_type use aotus_module, only: flu_State, aot_get_val, & & aoterr_Fatal, aoterr_NonExistent, & & aoterr_WrongType use aot_table_module, only: aot_table_open, aot_table_close, & & aot_table_length use tem_aux_module, only: tem_abort implicit none private public :: tem_cube_type public :: tem_load_cube public :: tem_convertTreeIDtoCube !> An auxilary data type to describe a cube. !! !! Here: The origin is the corner from which on the cube is spanned !! with the given length in each direction. type tem_cube_type real(kind=rk) :: origin(3) !< origin of the cube real(kind=rk) :: center(3) !< center of the cube real(kind=rk) :: extent !< length of the cube real(kind=rk) :: halfwidth !< half length of the cube real(kind=rk) :: endPnt(3) !< End point of the cube end type tem_cube_type contains ! **************************************************************************** !> This routine loads the boundCube table from config file ! **************************************************************************** subroutine tem_load_cube(me, conf, key, pos, parent) ! --------------------------------------------------------------------------! type(tem_cube_type), intent(out) :: me !< seeder cube type type(flu_state) :: conf !< lua state !> open cube table by given key character(len=*), optional, intent(in) :: key !> open cube table by position integer, optional, intent(in) :: pos !> if cube is to be load from pos, parent handle is required integer, optional, intent(in) :: parent ! --------------------------------------------------------------------------! integer :: thandle !< cube handle integer :: iError, vError(3), errFatal(3) real(kind=rk) :: deflen ! --------------------------------------------------------------------------! errFatal = aoterr_fatal me%origin = 0.0 deflen = 1.0_rk if (present(key)) then ! open cube table from given key call aot_table_open(L=conf, thandle=thandle, key=trim(key)) if (thandle == 0) then write(logunit(0),*) 'FATAL Error: cube definition not found with key:' write(logunit(0),*) (trim(key)) call tem_abort() end if else if (present(parent) .and. present(pos)) then ! else open cube from given table pos call aot_table_open(L=conf, parent = parent, thandle=thandle, pos=pos) if (thandle == 0) then write(logunit(0),*) & & 'FATAL Error: cube definition not found with pos:', pos call tem_abort() end if else write(logunit(0),*) 'ERROR: Neither key nor pos is provided to load ' & & //' cube table' call tem_abort() end if call aot_get_val(L=conf, thandle=thandle, val=me%origin, ErrCode=vError, & & key='origin', pos = 1, default=[0.0_rk, 0.0_rk, 0.0_rk] ) if (any(btest(vError, errFatal))) then write(logunit(0),*) 'FATAL Error occured, while retrieving cube origin.' call tem_abort() end if call aot_get_val(L=conf, thandle=thandle, & & val=me%extent, ErrCode=iError, & & key='length', pos=2, default=deflen) if (btest(iError, aoterr_Fatal)) then write(logunit(0),*) 'FATAL Error occured, while retrieving cube length:' if (btest(iError, aoterr_NonExistent)) & & write(logunit(0),*) 'Variable not existent!' if (btest(iError, aoterr_WrongType)) & & write(logunit(0),*) 'Variable has wrong type!' call tem_abort() else if (btest(iError, aoterr_NonExistent)) & & write(logunit(1),*) 'Variable length not set in configuration, ' & & //'using default value!' end if me%halfwidth = 0.5_rk*me%extent me%center = me%origin + me%halfwidth write(logunit(1),*) ' Cube origin: ', me%origin write(logunit(1),*) ' Cube length: ', me%extent call aot_table_close(L=conf, thandle=thandle) end subroutine tem_load_cube ! **************************************************************************** ! ************************************************************************** ! !> This routine converts treeID in given tree to cube subroutine tem_convertTreeIDtoCube(cube, tree, treeID) ! --------------------------------------------------------------------------! !> mesh information type(treelmesh_type), intent(in) :: tree !> input Element ID integer(kind=long_k), intent(in) :: TreeID type(tem_cube_type), intent(out) :: cube !< cube type ! --------------------------------------------------------------------------! cube%origin = tem_originOfId(tree, treeID) cube%endPnt = tem_endOfId(tree, treeID) cube%extent = tem_ElemSize(tree, treeID) cube%halfwidth = 0.5_rk*cube%extent cube%center = cube%origin + cube%halfwidth end subroutine tem_convertTreeIDtoCube ! ************************************************************************** ! end module tem_cube_module