get_top_quadruple_vvect Subroutine

private subroutine get_top_quadruple_vvect(val, ErrCode, maxlength, L, default)

Arguments

Type IntentOptional Attributes Name
real(kind=quad_k), intent(out), allocatable :: val(:)

Vector read from the Lua table, will have the same length as the table but not exceed maxlength, if provided.
integer, intent(out), allocatable :: ErrCode(:)

Error code describing problems encountered in each of the components. Will be allocated with the same length as the returned vector. If the complete vector is not given in the Lua script, and no default is provided, an zerosized array will be returned.
integer, intent(in) :: maxlength

Maximal length to allocate for the vector.
type(flu_State) :: L
real(kind=quad_k), intent(in), optional :: default(:)

A default vector to use, if no proper definition is found. Components will be filled with the help of this default definition.

Calls

proc~~get_top_quadruple_vvect~~CallsGraph proc~get_top_quadruple_vvect get_top_quadruple_vvect interface~aot_top_get_val~8 aot_top_get_val proc~get_top_quadruple_vvect->interface~aot_top_get_val~8 proc~aot_table_close aot_table_close proc~get_top_quadruple_vvect->proc~aot_table_close proc~aot_table_first aot_table_first proc~get_top_quadruple_vvect->proc~aot_table_first proc~aot_table_length aot_table_length proc~get_top_quadruple_vvect->proc~aot_table_length proc~aot_table_top aot_table_top proc~get_top_quadruple_vvect->proc~aot_table_top proc~flu_next flu_next proc~get_top_quadruple_vvect->proc~flu_next proc~aot_top_get_extdouble aot_top_get_extdouble interface~aot_top_get_val~8->proc~aot_top_get_extdouble proc~flu_settop flu_settop proc~aot_table_close->proc~flu_settop proc~aot_table_first->proc~flu_next proc~flu_pushnil flu_pushnil proc~aot_table_first->proc~flu_pushnil proc~aot_table_length->proc~aot_table_first proc~aot_table_length->proc~flu_next proc~flu_pop flu_pop proc~aot_table_length->proc~flu_pop proc~flu_gettop flu_gettop proc~aot_table_top->proc~flu_gettop proc~flu_istable flu_isTable proc~aot_table_top->proc~flu_istable proc~aot_table_top->proc~flu_pop interface~lua_next lua_next proc~flu_next->interface~lua_next proc~aot_top_get_extdouble->proc~flu_pop proc~flu_isnoneornil flu_isNoneOrNil proc~aot_top_get_extdouble->proc~flu_isnoneornil proc~flu_isnumber flu_isnumber proc~aot_top_get_extdouble->proc~flu_isnumber proc~flu_todouble flu_todouble proc~aot_top_get_extdouble->proc~flu_todouble interface~lua_gettop lua_gettop proc~flu_gettop->interface~lua_gettop interface~lua_type lua_type proc~flu_istable->interface~lua_type interface~lua_settop lua_settop proc~flu_pop->interface~lua_settop interface~lua_pushnil lua_pushnil proc~flu_pushnil->interface~lua_pushnil proc~flu_settop->interface~lua_settop proc~flu_isnoneornil->interface~lua_type interface~lua_isnumber lua_isNumber proc~flu_isnumber->interface~lua_isnumber interface~lua_tonumberx lua_tonumberx proc~flu_todouble->interface~lua_tonumberx

Called by

proc~~get_top_quadruple_vvect~~CalledByGraph proc~get_top_quadruple_vvect get_top_quadruple_vvect interface~aot_top_get_val aot_top_get_val interface~aot_top_get_val->proc~get_top_quadruple_vvect

Source Code

  subroutine get_top_quadruple_vvect(val, ErrCode, maxlength, L, default)
    type(flu_State) :: L !< Handle to the lua script

    !> Vector read from the Lua table, will have the same length as the table
    !! but not exceed maxlength, if provided.
    real(kind=quad_k), intent(out), allocatable :: val(:)

    !> Error code describing problems encountered in each of the components.
    !! Will be allocated with the same length as the returned vector.
    !! If the complete vector is not given in the Lua script, and no default
    !! is provided, an zerosized array will be returned.
    integer, intent(out), allocatable :: ErrCode(:)

    !> Maximal length to allocate for the vector.
    integer, intent(in) :: maxlength

    !> A default vector to use, if no proper definition is found.
    !! Components will be filled with the help of this default definition.
    real(kind=quad_k), intent(in), optional :: default(:)

    integer :: vect_handle
    integer :: table_len, vect_len, def_len
    integer :: vect_lb
    integer :: iComp

    ! Try to interpret the top entry on the stack as a table
    vect_handle = aot_table_top(L=L)
    table_len = aot_table_length(L=L, thandle=vect_handle)

    ! The size of the vector is limited by maxlength.
    vect_len = min(maxlength, table_len)

    ! Find the length of the default value, if it is not provided, its 0.
    def_len = 0
    if (present(default)) def_len = size(default)

    ! Now parse the table with the vector entries.
    if (aot_table_first(L, vect_handle)) then
      allocate(val(vect_len))
      allocate(errCode(vect_len))

      ErrCode = 0

      ! Only if the vector table actually exists, and has at least one entry,
      ! this parsing has to be done.
      if (present(default).and.(def_len > 0)) then
        call aot_top_get_val(val(1), ErrCode(1), L, default(1))
      else
        call aot_top_get_val(val(1), ErrCode(1), L)
      end if

      ! Up to the length of the default value, provide the default settings.
      do iComp=2,def_len
        if (.not. flu_next(L, vect_handle)) exit
        call aot_top_get_val(val(iComp), ErrCode(iComp), L, &
          &                  default(iComp))
      end do

      vect_lb = max(2, def_len+1)
      ! After def_len entries no default values for the components are
      ! available anymore, proceed without a default setting for the rest.
      do iComp=vect_lb,vect_len
        if (.not. flu_next(L, vect_handle)) exit
        call aot_top_get_val(val(iComp), ErrCode(iComp), L)
      end do
    else
      ! No vector definition found in the Lua script, use the default.
      if (present(default)) then
        allocate(val(def_len))
        allocate(errCode(vect_len))
        val(:) = default
        ErrCode = ibSet(0, aoterr_NonExistent)
      else
        ! No vector definition in the Lua script and no default provided,
        ! return an empty array.
        allocate(val(0))
        allocate(errCode(0))
      end if
    end if
    call aot_table_close(L, vect_handle)

  end subroutine get_top_quadruple_vvect