tem_load_spacetime_single Subroutine

private recursive subroutine tem_load_spacetime_single(me, conf, parent, key, pos, nComp, errCode, recurred)

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 = {..}}
  • lua_function
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.

Arguments

Type IntentOptional 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)

Calls

proc~~tem_load_spacetime_single~~CallsGraph proc~tem_load_spacetime_single tem_load_spacetime_single proc~tem_load_spacetime_single->proc~tem_load_spacetime_single aot_exists aot_exists proc~tem_load_spacetime_single->aot_exists aot_fun_close aot_fun_close proc~tem_load_spacetime_single->aot_fun_close aot_fun_open aot_fun_open proc~tem_load_spacetime_single->aot_fun_open aot_get_val aot_get_val proc~tem_load_spacetime_single->aot_get_val aot_reference_for aot_reference_for proc~tem_load_spacetime_single->aot_reference_for aot_table_open aot_table_open proc~tem_load_spacetime_single->aot_table_open aot_type_of aot_type_of proc~tem_load_spacetime_single->aot_type_of interface~tem_load_shape tem_load_shape proc~tem_load_spacetime_single->interface~tem_load_shape proc~load_spacetime_asconst load_spacetime_asConst proc~tem_load_spacetime_single->proc~load_spacetime_asconst proc~load_spacetime_predefined load_spacetime_predefined proc~tem_load_spacetime_single->proc~load_spacetime_predefined proc~tem_abort tem_abort proc~tem_load_spacetime_single->proc~tem_abort proc~tem_load_shape_single tem_load_shape_single interface~tem_load_shape->proc~tem_load_shape_single proc~tem_load_shapes tem_load_shapes interface~tem_load_shape->proc~tem_load_shapes proc~load_spacetime_asconst->aot_get_val proc~load_spacetime_predefined->proc~tem_abort interface~tem_load_miescatter_displacementfieldz tem_load_miescatter_displacementfieldz proc~load_spacetime_predefined->interface~tem_load_miescatter_displacementfieldz interface~tem_load_miescatter_magneticfieldx tem_load_miescatter_magneticfieldx proc~load_spacetime_predefined->interface~tem_load_miescatter_magneticfieldx interface~tem_load_miescatter_magneticfieldy tem_load_miescatter_magneticfieldy proc~load_spacetime_predefined->interface~tem_load_miescatter_magneticfieldy proc~tem_aps_load_coupling tem_aps_load_coupling proc~load_spacetime_predefined->proc~tem_aps_load_coupling proc~tem_load_acoustic_pulse tem_load_acoustic_pulse proc~load_spacetime_predefined->proc~tem_load_acoustic_pulse proc~tem_load_cylindricalwave tem_load_cylindricalWave proc~load_spacetime_predefined->proc~tem_load_cylindricalwave proc~tem_load_spatial tem_load_spatial proc~load_spacetime_predefined->proc~tem_load_spatial proc~tem_load_temporal tem_load_temporal proc~load_spacetime_predefined->proc~tem_load_temporal proc~tem_polygon_material_multi_load tem_polygon_material_multi_load proc~load_spacetime_predefined->proc~tem_polygon_material_multi_load proc~tem_polygon_material_single_load tem_polygon_material_single_load proc~load_spacetime_predefined->proc~tem_polygon_material_single_load proc~upper_to_lower upper_to_lower proc~load_spacetime_predefined->proc~upper_to_lower tem_precice_load_coupling tem_precice_load_coupling proc~load_spacetime_predefined->tem_precice_load_coupling mpi_abort mpi_abort proc~tem_abort->mpi_abort

Called by

proc~~tem_load_spacetime_single~~CalledByGraph proc~tem_load_spacetime_single tem_load_spacetime_single proc~tem_load_spacetime_single->proc~tem_load_spacetime_single interface~tem_load_spacetime tem_load_spacetime interface~tem_load_spacetime->proc~tem_load_spacetime_single proc~tem_load_spacetime_table tem_load_spacetime_table interface~tem_load_spacetime->proc~tem_load_spacetime_table proc~tem_load_spacetime_table->proc~tem_load_spacetime_single proc~tem_variable_load_single tem_variable_load_single proc~tem_variable_load_single->interface~tem_load_spacetime proc~tem_variable_loadmapping_single tem_variable_loadMapping_single proc~tem_variable_loadmapping_single->interface~tem_load_spacetime interface~tem_variable_load tem_variable_load interface~tem_variable_load->proc~tem_variable_load_single proc~tem_variable_load_vector tem_variable_load_vector interface~tem_variable_load->proc~tem_variable_load_vector interface~tem_variable_loadmapping tem_variable_loadMapping interface~tem_variable_loadmapping->proc~tem_variable_loadmapping_single proc~tem_variable_loadmapping_vector tem_variable_loadMapping_vector interface~tem_variable_loadmapping->proc~tem_variable_loadmapping_vector proc~tem_variable_load_vector->proc~tem_variable_load_single proc~tem_variable_loadmapping_vector->proc~tem_variable_loadmapping_single proc~tem_load_bc_state tem_load_bc_state proc~tem_load_bc_state->interface~tem_variable_loadmapping

Source Code

  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