input_dbl2d Function

private function input_dbl2d(me, key, default_value) result(val)

Type Bound

input_t

Arguments

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

default value in case of missing key

Return Value real(kind=dp), allocatable, (:,:)


Calls

proc~~input_dbl2d~~CallsGraph proc~input_dbl2d input_t%input_dbl2d proc~continue_if continue_if proc~input_dbl2d->proc~continue_if proc~get2d_hdf5 get2d_hdf5 proc~input_dbl2d->proc~get2d_hdf5 proc~input_has_key input_t%input_has_key proc~input_dbl2d->proc~input_has_key proc~input_node input_t%input_node proc~input_dbl2d->proc~input_node proc~select_list select_list proc~input_dbl2d->proc~select_list proc~select_scalar select_scalar proc~input_dbl2d->proc~select_scalar to_real to_real proc~input_dbl2d->to_real proc~get2d_hdf5->proc~input_has_key h5dclose_f h5dclose_f proc~get2d_hdf5->h5dclose_f h5dopen_f h5dopen_f proc~get2d_hdf5->h5dopen_f h5dread_f h5dread_f proc~get2d_hdf5->h5dread_f h5fclose_f h5fclose_f proc~get2d_hdf5->h5fclose_f h5fopen_f h5fopen_f proc~get2d_hdf5->h5fopen_f h5ltget_dataset_info_f h5ltget_dataset_info_f proc~get2d_hdf5->h5ltget_dataset_info_f proc~input_str input_t%input_str proc~get2d_hdf5->proc~input_str 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 proc~input_str->proc~input_has_key proc~input_str->proc~input_node proc~input_str->proc~select_scalar

Called by

proc~~input_dbl2d~~CalledByGraph proc~input_dbl2d input_t%input_dbl2d proc~signal_init signal_t%signal_init proc~signal_init->proc~input_dbl2d proc~boundary_init_part1 boundary_init_part1 proc~boundary_init_part1->proc~signal_init proc~channel_init_part1 channel_init_part1 proc~channel_init_part1->proc~signal_init proc~mesh2d_init_part1 mesh2D_init_part1 proc~mesh2d_init_part1->proc~signal_init proc~sim_init simulation_t%sim_init proc~sim_init->proc~signal_init proc~solid_init_part1 solid_init_part1 proc~solid_init_part1->proc~signal_init proc~strand_init_part1 strand_init_part1 proc~strand_init_part1->proc~signal_init program~reims_p reims_p program~reims_p->proc~boundary_init_part1 program~reims_p->proc~channel_init_part1 program~reims_p->proc~mesh2d_init_part1 program~reims_p->proc~sim_init program~reims_p->proc~solid_init_part1 program~reims_p->proc~strand_init_part1

Source Code

function input_dbl2d(me,key,default_value) result(val)
    class(input_t), intent(in) :: me
    character(*),    intent(in) :: key
    real(dp), optional, intent(in) :: default_value(:,:) !! default value in case of missing key
    real(dp),  allocatable :: val(:,:)

    type(type_list),       pointer :: element, element1
    type(type_scalar),     pointer :: element2
    type(type_list_item),  pointer :: item1, item2
    integer :: i,j,dim1,dim2
    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_list)
        ! Setting the first element and shaping matrix accordingly 
        dim1 = node%size()
        item1 => node%first
        element => select_list(item1%node)
        dim2 = element%size()
        item2 => element%first
        if (allocated(val)) deallocate(val)
        allocate(val(dim1,dim2))

        i = 1; j = 1
        do while(associated(item1))
            element1 => select_list(item1%node)
            if(element1%size()/=dim2) error stop &
                    "2D array size is inconsistent for: "//element1%path
            j = 1
            item2 => element1%first
            do while(associated(item2))
                element2 => select_scalar(item2%node);
                val(i,j) = element2%to_real(0.0_dp,ok)
                call continue_if(element2,ok)
                item2 => item2%next
                j = j + 1
            enddo
            item1 => item1%next
            i = i + 1
        enddo
        return
        class is(type_dictionary)
        tmp%root => node
        if(get2d_hdf5(tmp,val)) return
    end select
    if(present(default_value)) return
    error stop 'Can not convert to 2d array of "double" for key: '//key
end function input_dbl2d