input_int1d Function

private function input_int1d(me, key, default_value, n) result(val)

Type Bound

input_t

Arguments

Type IntentOptional Attributes Name
class(input_t), intent(in) :: me
character(len=*), intent(in) :: key
integer, intent(in), optional :: default_value(:)

default value in case of missing key
integer, intent(in), optional :: n

expected number of elements in the array (can be used broadcast scalar to array)

Return Value integer, allocatable, (:)


Calls

proc~~input_int1d~~CallsGraph proc~input_int1d input_t%input_int1d interface~to_str to_str proc~input_int1d->interface~to_str proc~continue_if continue_if proc~input_int1d->proc~continue_if proc~get1d_range get1d_range proc~input_int1d->proc~get1d_range proc~input_has_key input_t%input_has_key proc~input_int1d->proc~input_has_key proc~input_node input_t%input_node proc~input_int1d->proc~input_node proc~select_scalar select_scalar proc~input_int1d->proc~select_scalar to_integer to_integer proc~input_int1d->to_integer proc~str_from_int str_from_int interface~to_str->proc~str_from_int proc~str_from_real str_from_real interface~to_str->proc~str_from_real proc~get1d_range->proc~input_has_key get get proc~input_has_key->get proc~select_dict select_dict proc~input_has_key->proc~select_dict proc~input_node->get proc~dictionary_traverse dictionary_traverse proc~input_node->proc~dictionary_traverse proc~input_node->proc~select_dict proc~dictionary_traverse->proc~dictionary_traverse get_dictionary get_dictionary proc~dictionary_traverse->get_dictionary proc~abort_if abort_if proc~dictionary_traverse->proc~abort_if

Called by

proc~~input_int1d~~CalledByGraph proc~input_int1d input_t%input_int1d proc~ffsrclink_init_part1 FFsrcLink_init_part1 proc~ffsrclink_init_part1->proc~input_int1d proc~ffsrclink_init_part2 FFsrcLink_init_part2 proc~ffsrclink_init_part2->proc~input_int1d proc~fslink_init_part1 FSlink_init_part1 proc~fslink_init_part1->proc~input_int1d proc~fslink_init_part2 FSlink_init_part2 proc~fslink_init_part2->proc~input_int1d proc~sssrclink_init_part1 SSsrcLink_init_part1 proc~sssrclink_init_part1->proc~input_int1d proc~sssrclink_init_part2 SSsrcLink_init_part2 proc~sssrclink_init_part2->proc~input_int1d program~reims_p reims_p program~reims_p->proc~ffsrclink_init_part1 program~reims_p->proc~ffsrclink_init_part2 program~reims_p->proc~fslink_init_part1 program~reims_p->proc~fslink_init_part2 program~reims_p->proc~sssrclink_init_part1 program~reims_p->proc~sssrclink_init_part2

Source Code

function input_int1d(me,key,default_value,n) result(val)
    class(input_t), intent(in) :: me
    character(*),    intent(in) :: key
    integer, optional, intent(in) :: default_value(:) !! default value in case of missing key
    integer, optional, intent(in) :: n !! expected number of elements in the array (can be used broadcast scalar to array)
    integer, allocatable :: val(:)

    type(type_list_item),  pointer :: item
    type(type_scalar),     pointer :: element
    integer :: i
    logical :: ok
    type(input_t) :: tmp

    if(present(default_value)) val = default_value
    if(.not.me%has_key(key) .and. present(default_value)) return
    select type(node=>me%node(key))
    class is(type_scalar)
        if (.not. present(n)) &
            error stop 'input_int1d: scalar node requires "n" for key: '//key
        if (allocated(val)) deallocate(val)
        allocate(val(n))
        val = node%to_integer(0, ok)
        call continue_if(node, ok)
        return
    class is(type_list)
        if (allocated(val)) deallocate(val)
        allocate(val(node%size()))
        item => node%first
        i = 1
        do while(associated(item))
            element => select_scalar(item%node);
            val(i) = element%to_integer(0,ok)
            call continue_if(element,ok)
            item => item%next
            i = i + 1
        enddo
        if (present(n)) then
            if (size(val) /= n) then
                print*, 'Expected '//to_str(n)//' elements for "'//key//'" but YAML has '//to_str(size(val))
                error stop 'Array size mismatch in YAML input.'
            endif
        endif
        return
    class is(type_dictionary)
        tmp%root => node
        if(get1d_range(tmp,val)) return
    end select
    if(present(default_value)) return
    error stop 'Can not convert to 1d array of "integer" for key: '//key
end function input_int1d