! Copyright (c) 2013-2014 Jens Zudrop <j.zudrop@grs-sim.de> ! Copyright (c) 2013 Verena Krupp <verena.krupp@uni-siegen.de> ! Copyright (c) 2013-2015 Harald Klimach <harald.klimach@uni-siegen.de> ! Copyright (c) 2013, 2017 Peter Vitt <peter.vitt2@uni-siegen.de> ! Copyright (c) 2016 Tobias Girresser <tobias.girresser@student.uni-siegen.de> ! ! Permission to use, copy, modify, and distribute this software for any ! purpose with or without fee is hereby granted, provided that the above ! copyright notice and this permission notice appear in all copies. ! ! THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHORS DISCLAIM ALL WARRANTIES ! WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF ! MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ! ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES ! WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ! ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF ! OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ! **************************************************************************** ! !> author: Jens Zudrop !! Routines and datatypes realted to specification and definition !! of the 1D MODG scheme. module atl_modg_1d_scheme_module use env_module, only: rk, labelLen use aotus_module, only: flu_State, aot_get_val use aot_top_module, only: aoterr_Fatal, aoterr_NonExistent use aot_table_module, only: aot_table_open, aot_table_close, aot_table_length use tem_aux_module, only: tem_abort use tem_tools_module, only: upper_to_lower use tem_logging_module, only: logUnit use ply_dof_module, only: Q_space implicit none private !> Datatype for the modg scheme type atl_modg_1d_scheme_type !> The maximal polynomial degree per spatial direction. integer :: maxPolyDegree !> Polynomial basis type. !! !! 3D Monomials have the form x^i * y^j * z^k !! - Q_space: quadratic polynomial space (i,j,k) <= maxPolyDegree !! - P_space: polynomial space i+j+k <= maxPolyDegree integer :: basisType !> Facial Chebyshev nodes (reference element) for 1 spatial direction !! and left and right face. These points are necessary to transfer !! boundary conditions given in physical space to modal space by !! means of an FPT. !! type(atl_faceChebNodes_type), allocatable :: chebNodesFace(:,:) end type atl_modg_1d_scheme_type public :: atl_modg_1d_scheme_type public :: atl_modg_1d_scheme_init contains subroutine atl_modg_1d_scheme_init(me, nDofs, nFaceDofs, & & conf, thandle, currentLevel, maxLevel ) type(atl_modg_1d_scheme_type), intent(out) :: me integer, intent(out) :: nDofs integer, intent(out) :: nFaceDofs type(flu_State) :: conf integer, intent(in) :: thandle !> The current level of the mesh integer, intent(in) :: currentLevel !> The maximal level of the mesh integer, intent(in) :: maxLevel character(len=labelLen) :: modg_1d_space character(len=labelLen) :: polyspace integer :: degree integer :: iError ! Find the maximal polynomial degree for the current level. call atl_modg_1d_scheme_load_polyDegree(degree, conf, thandle, & & currentlevel, maxlevel) ! Read the chosen polynomial space call aot_get_val(L = conf, thandle = thandle, & & key = 'modg_1d_space', & & val = modg_1d_space, & & ErrCode = iError, & & default = 'Q' ) polyspace = upper_to_lower(modg_1d_space) polyspace = adjustl(polyspace) select case(trim(polyspace)) case('q') me%basisType = Q_space nDofs = (degree+1) nFaceDofs = 1 me%maxPolyDegree = degree case default write(logUnit(1),*) 'ERROR in init_kernel_state: unknown modg_1d_space: ' & & // trim(modg_1d_space) // ' !' write(logUnit(1),*) 'Supported are:' write(logUnit(1),*) '* Q (quadratic with i,j,k <= maxDegree' write(logUnit(1),*) 'Stopping....' call tem_abort() end select write(logUnit(1),*) 'MODG scheme with '//trim(modg_1d_space)//' basis on level ', & & currentLevel write(logUnit(1),*) '... maximal polynomial degree: ', degree end subroutine atl_modg_1d_scheme_init subroutine atl_modg_1d_scheme_load_polyDegree(degree, conf, thandle, & & currentlevel, maxlevel) integer, intent(out) :: degree type(flu_state) :: conf integer, intent(in) :: thandle integer, intent(in) :: currentLevel integer, intent(in) :: maxLevel character(len=labelLen) :: predefDegrees character(len=labelLen) :: predeg integer :: mtable integer :: degTable integer :: iError integer :: nDegTables integer :: iTable integer :: tableLevel logical :: foundLevel real(kind=rk) :: levelFact, base_order ! Get the degree of the scheme call aot_get_val(L = conf, thandle = thandle, & & key = 'm', & & val = degree, & & ErrCode = iError) ! if no error occurs, we have a global polynomial degree if (iError.ne.0) then ! open the spatial subtable call aot_table_open(L=conf, parent=thandle, & & thandle = mtable, key = 'm') call aot_get_val(L = conf, thandle = mtable, key = 'predefined', & & val = predefDegrees, ErrCode = iError) predef: if (btest(iError, aoterr_nonExistent)) then ! No predefined set of polynomial degrees, try to get them ! individually for each level. ! The number of tables in the m table nDegTables = aot_table_length(L = conf, thandle = mTable) ! Iterate over all the sub tables and check if one has ! the current mesh level foundLevel = .false. do iTable = 1, nDegTables call aot_table_open(L = conf, parent = mTable, thandle = degTable, & & pos = iTable) ! get the level of the current table call aot_get_val( L = conf, thandle = degTable, key = 'level', & & val = tableLevel, ErrCode = iError ) if (iError.ne.0) then write(logUnit(1),*) 'ERROR in atl_modg_1d_scheme_init: not able to read' & & //' level for ' write(logUnit(1),*) ' the level specific polynomial degree!' write(logUnit(1),*) 'STOPPING ...' call tem_abort() end if if (tableLevel.eq.currentLevel) then ! read the degree for the level call aot_get_val( L = conf, thandle = degTable, key = 'm', & & val = degree, ErrCode = iError ) if (iError.ne.0) then write(logUnit(1),*) 'ERROR in atl_modg_1d_scheme_init: not able to ' & & //' read degree for ' write(logUnit(1),*) ' the level specific polynomial degree!' write(logUnit(1),*) ' Failing level: ', currentLevel write(logUnit(1),*) 'STOPPING ...' call tem_abort() end if foundLevel = .true. end if call aot_table_close(L = conf, thandle = degtable) end do ! Check if we found a degree for the current level of the mesh if (.not.foundlevel) then write(logUnit(1),*) 'ERROR in atl_modg_1d_scheme_init:' write(logUnit(1),*) ' level not found for the level specific' & & // ' polynomial degree!' write(logUnit(1),*) ' Failing level: ', currentLevel write(logUnit(1),*) 'STOPPING ...' call tem_abort() end if else predef if (btest(iError, aoterr_Fatal)) then write(logUnit(1),*) 'ERROR in atl_modg_1d_scheme_init: ' & & // 'could not read the predefined polynomial' write(logUnit(1),*) ' degrees for different levels!' write(logUnit(1),*) 'ABORTING...' call tem_abort() end if predeg = upper_to_lower(predefDegrees) predeg = adjustl(predeg) select case(trim(predeg)) case ('fixedfact') ! This set of degrees increases the polynomial degrees by a fixed ! factor from level to level according to the following formula: ! m(iLevel) = nint(baseOrder*(factor**(maxLevel-iLevel)) - 1) ! Get the factor to increase the order level by level. ! Defaults to sqrt(2), as this maintains approximately the same ! time step restriction throughout the domain. call aot_get_val(L = conf, thandle = mtable, key = 'factor', & & val = levelFact, default = sqrt(2.0_rk), & & ErrCode = iError) if (btest(iError, aoterr_Fatal)) then write(logUnit(1),*) 'ERROR in atl_modg_1d_scheme_init: ' & & // 'could not read the factor for the' write(logUnit(1),*) ' predefined fixedfact set of degrees!' write(logUnit(1),*) 'ABORTING...' call tem_abort() end if ! Get the base order to use on the maximal level. ! Defaults to 1. call aot_get_val(L = conf, thandle = mtable, key = 'base_order', & & val = base_order, default = 1.0_rk, & & ErrCode = iError) if (btest(iError, aoterr_Fatal)) then write(logUnit(1),*) 'ERROR in atl_modg_1d_scheme_init: ' & & // 'could not read the base_order for the' write(logUnit(1),*) ' predefined fixedfact set of degrees!' write(logUnit(1),*) 'ABORTING...' call tem_abort() end if degree = nint( base_order*(levelFact**(maxLevel-currentLevel)) & & - 1.0_rk ) case default write(logUnit(1),*) 'ERROR in atl_modg_1d_scheme_init: ' & & // 'unknoen predefined polynomial degrees:' write(logUnit(1),*) trim(predefDegrees) write(logUnit(1),*) 'Currently supported predefined sets are:' write(logUnit(1),*) ' * fixedFact (use a fixed factor between levels)' write(logUnit(1),*) 'ABORTING...' call tem_abort() end select end if predef ! Close the m table call aot_table_close(L = conf, thandle = mtable) end if end subroutine atl_modg_1d_scheme_load_polyDegree end module atl_modg_1d_scheme_module