get_top_extdouble_v Subroutine

private subroutine get_top_extdouble_v(val, ErrCode, L, default)

Arguments

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

Vector read from the Lua table.
integer, intent(out) :: ErrCode(:)

Error code describing problems encountered in each of the components. This array has to have the same length as val.
type(flu_State) :: L
real(kind=xdble_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_extdouble_v~~CallsGraph proc~get_top_extdouble_v get_top_extdouble_v interface~aot_top_get_val~8 aot_top_get_val proc~get_top_extdouble_v->interface~aot_top_get_val~8 proc~aot_table_close aot_table_close proc~get_top_extdouble_v->proc~aot_table_close proc~aot_table_first aot_table_first proc~get_top_extdouble_v->proc~aot_table_first proc~aot_table_length aot_table_length proc~get_top_extdouble_v->proc~aot_table_length proc~aot_table_top aot_table_top proc~get_top_extdouble_v->proc~aot_table_top proc~flu_next flu_next proc~get_top_extdouble_v->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_extdouble_v~~CalledByGraph proc~get_top_extdouble_v get_top_extdouble_v interface~aot_top_get_val~7 aot_top_get_val interface~aot_top_get_val~7->proc~get_top_extdouble_v

Source Code

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

    !> Vector read from the Lua table.
    real(kind=xdble_k), intent(out) :: val(:)

    !> Error code describing problems encountered in each of the components.
    !! This array has to have the same length as val.
    integer, intent(out) :: ErrCode(:)

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

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

    ErrCode = 0

    ! Try to interpret it as table.
    vect_handle = aot_table_top(L=L)
    table_len = aot_table_length(L=L, thandle=vect_handle)

    val_len = size(val)
    vect_len = min(table_len, val_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).and.(vect_len > 0)) then

      ! 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

      ! If the table in the Lua script is not long enough, fill the remaining
      ! components with the default components, as far as they are defined.
      do iComp=vect_len+1,def_len
        ErrCode(iComp) = ibSet(ErrCode(iComp), aoterr_NonExistent)
        val(iComp) = default(iComp)
      end do
      vect_lb = max(vect_len+1, def_len)
      do iComp=vect_lb,val_len
        ErrCode(iComp) = ibSet(ErrCode(iComp), aoterr_Fatal)
      end do
    else
      ! No vector definition found in the Lua script, use the default.
      ErrCode = ibSet(ErrCode, aoterr_NonExistent)
      if (present(default)) then
        val(:def_len) = default(:def_len)
        if (def_len < val_len) then
          ErrCode(def_len+1:) = ibSet(ErrCode(def_len+1:), aoterr_Fatal)
        end if
      else
        ! No vector definition in the Lua script and no default provided.
        ErrCode = ibSet(ErrCode, aoterr_Fatal)
      end if
    end if
    call aot_table_close(L, vect_handle)

  end subroutine get_top_extdouble_v