This routine loads the single spacetime function from the given key or position
If spacetime is defined as block than read block for key word predefined/fun/const and load shape inside a block else define directly as lua function or constant. If predefined is defined inside a block, define other neccessary parameters for predefined. If shape table is not defined, shape is set to "all"
Valid definitions: - Constant
st_fun = 1.0
or
st_fun = {const = 1.0, shape = {..}}
st_fun = lua_fun_name
--or
st_fun = {fun=lua_fun_name, shape={..}}
Note. Lua function take 4 input arguments (x,y,z,t) i.e barycentric coordinates of an element and time - Predefined Fortran function
st_fun = {predefined = "fun_name", fun_parameters}
This definition can itself to be part of tables to define multiple space time functions.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(tem_spacetime_fun_type), | intent(out) | :: | me |
spacetime fun information |
||
| type(flu_State) | :: | conf |
lua state type |
|||
| integer, | intent(in), | optional | :: | parent |
aotus parent handle |
|
| character(len=*), | intent(in), | optional | :: | key |
name of the variable which is defined as spacetime function |
|
| integer, | intent(in), | optional | :: | pos |
position of spacetime fun in a table |
|
| integer, | intent(in), | optional | :: | nComp |
number of components of the variable |
|
| integer, | intent(out), | optional | :: | errCode |
errCode /=0, space time function fails use errCode to abort code outside this routine call |
|
| integer, | intent(in), | optional | :: | recurred |
Number of recursion steps done so far (defaults to 0) |
recursive subroutine tem_load_spacetime_single( me, conf, parent, key, pos, &
& nComp, errCode, recurred )
! -------------------------------------------------------------------- !
!> spacetime fun information
type(tem_spacetime_fun_type), intent(out) :: me
!> lua state type
type(flu_State) :: conf
!> aotus parent handle
integer, intent(in), optional :: parent
!> name of the variable which is defined as spacetime function
character(len=*), intent(in), optional :: key
!> position of spacetime fun in a table
integer, intent(in), optional :: pos
!> number of components of the variable
integer, intent(in), optional :: nComp
!> errCode /=0, space time function fails
!! use errCode to abort code outside this routine call
integer, optional, intent(out) :: errCode
!> Number of recursion steps done so far (defaults to 0)
integer, optional, intent(in) :: recurred
! -------------------------------------------------------------------- !
type(aot_fun_type) :: fun
! aotus handle
integer :: thandle
! error variables
integer :: iError, iError_shape
! local ncomp
logical :: stFunNotATable
integer :: ltype
logical :: has_key(3) ! There are three different possible keys we need
! to check for.
character(len=labelLen) :: fun_key
integer :: loc_recurred
! -------------------------------------------------------------------- !
loc_recurred = 0
if (present(recurred)) loc_recurred = recurred
iError = huge(iError)
iError_shape = huge(iError_shape)
if (present(ErrCode)) ErrCode = iError
! Do not allow more than 1 recursion step
if (loc_recurred > 1) RETURN
if (present(key)) then
write(logUnit(3),*) 'loading space time function from key: ', trim(key)
end if
! store conf to load lua space time function
me%conf = conf
! default values
stFunNotATable = .true.
me%fun_kind = 'none'
if (present(nComp)) then
me%nComps = nComp
else
me%nComps = 1
end if
ltype = aot_type_of( L = conf, &
& thandle = parent, &
& key = key, &
& pos = pos )
select case(ltype)
case(FLU_TNUMBER)
write(logunit(9),*) 'Trying to load ST-Fun as a scalar constant...'
! Try to load the top of the stack as a constant value.
call load_spacetime_asConst( me = me, &
& conf = conf, &
& errCode = iError, &
& nComp = nComp )
case(FLU_TFUNCTION)
! Try to interpret the top of the stack as a Lua function.
write(logunit(9),*) 'Trying to load ST-Fun as Lua function...'
call aot_fun_open( L = conf, &
& fun = fun )
if (fun%handle /= 0) then
write(logunit(9),*) '... ST-Fun is a Lua function!'
! There is a function defined in Lua.
me%fun_kind = 'lua_fun'
! Store a reference to this function.
me%lua_fun_ref = aot_reference_for(conf)
call aot_fun_close( L=conf, fun=fun )
iError = 0
else
iError = -1
end if
case(FLU_TSTRING)
if (loc_recurred == 1) then
write(logunit(9),*) 'Trying to load ST-Fun as predefined function...'
call aot_get_val( L = conf, &
& val = me%fun_kind, &
& default = 'none', &
& ErrCode = iError )
if (iError == 0) then
call load_spacetime_predefined( me = me, &
& conf = conf, &
& thandle = parent, &
& nComp = nComp )
end if
else
! A predefined spacetime function is not possible without an embedding
! table, return an error if we are not inside a table!
iError = -1
end if
case(FLU_TTABLE)
! First, try to interpret the table as a vectorial constant.
write(logunit(9),*) 'Trying to load ST-Fun as a vectorial constant...'
! Try to load the top of the stack as a constant value.
call load_spacetime_asConst( me = me, &
& conf = conf, &
& errCode = iError, &
& nComp = nComp )
if (iError < 0) then
write(logunit(9),*) '... not a vectorial constant.'
call aot_table_open( L = conf, &
& thandle = thandle, &
& parent = parent, &
& key = key, &
& pos = pos )
recursion: if (loc_recurred == 0) then
write(logunit(9),*) 'Trying to obtain spacetime function definition' &
& // ' within the provided table.'
stFunNotATable = .false.
! For backwards compatibility we have several options to use as
! keywords for the function definition.
! Exactly one of them has to be defined.
has_key(1) = aot_exists( L = conf, &
& thandle = thandle, &
& key = 'const' )
if (has_key(1)) fun_key = 'const'
has_key(2) = aot_exists( L = conf, &
& thandle = thandle, &
& key = 'fun' )
if (has_key(2)) fun_key = 'fun'
has_key(3) = aot_exists( L = conf, &
& thandle = thandle, &
& key = 'predefined' )
if (has_key(3)) fun_key = 'predefined'
! Only if exactly one key is defined, we proceed and try to load
! that as a space-time function itself.
if ( count(has_key) == 1 ) then
call tem_load_spacetime_single( me = me, &
& conf = conf, &
& parent = thandle, &
& key = trim(fun_key), &
& nComp = nComp, &
& errCode = iError, &
& recurred = loc_recurred + 1 )
end if
! Only during first call try to load the shape for the function, and
! identify function itself by one of the keywords.
! As the definition is a table, there might be a
! shape defined to restrict the area of the function.
! Shape either has to be given via the keyword 'shape'.
write(logunit(9),*) 'Trying to obtain the shape...'
call tem_load_shape( me = me%geom, &
& conf = conf, &
& parent = thandle, &
& key = 'shape', &
& iError = iError_shape )
else recursion
! Loading predefined space time function from a subtable.
write(logunit(9),*) '... failed loading vectorial constant'
write(logunit(9),*) 'Attempting to load a predefined function in' &
& // ' a subtable.'
call aot_table_open( L = conf, &
& thandle = thandle, &
& parent = parent, &
& key = key, &
& pos = pos )
call aot_get_val( L = conf, &
& val = me%fun_kind, &
& thandle = thandle, &
& pos = 1, &
& default = 'none', &
& ErrCode = iError )
if (iError == 0) then
call load_spacetime_predefined( me = me, &
& conf = conf, &
& thandle = thandle, &
& nComp = nComp )
end if
end if recursion
end if
end select
if ( trim(me%fun_kind) == 'const') then
if ( me%nComps /= size(me%const) ) then
write(logUnit(1),*) 'WARNING: In loading stFun, nComps of const ' &
& //'loaded:', size(me%const)
write(logUnit(1),*) ' does not match argumental nComps: ', &
& me%nComps
write(logUnit(1),*) ' Setting nComps to size(const).'
me%nComps = size(me%const)
end if
end if
if (loc_recurred == 0) then
if (iError /= 0) then
me%fun_kind = 'none'
write(logunit(3), *) 'Could not load spacetime function!'
end if
if (trim(me%fun_kind) == 'const') &
& write(logUnit(3),*) &
& 'Spacetime function is a const value: ', me%const
! if shape is defined inside a table but function type is not
! defined with key word "fun", "predefined", "const" then
! terminate code with error message
if (iError_shape == 0 .and. iError == -1) then
write(logUnit(1),*) 'ERROR: Shape is defined inside a table but' &
& // ' spacetime function is unidentified.'
write(logUnit(1),*) 'Provide spacetime function kind via key word:' &
& // ' "fun" / "predefined" / "const"'
call tem_abort()
end if
! if shape table is not defined
if (stFunNotATable .and. iError /= -1) then
write(logUnit(1),*) 'St-fun is not a table, thus setting global shape.'
if (allocated(me%geom)) deallocate(me%geom)
allocate(me%geom(1))
me%geom(1)%kind = 'all'
me%geom(1)%shapeID = tem_global_shape
end if
end if
if (present(errCode)) errCode = iError
end subroutine tem_load_spacetime_single