expose_state_to_ext_library Subroutine

subroutine expose_state_to_ext_library(h5_ptr) bind(C)
    type(c_ptr) :: h5_ptr

    ! REIMS builds an H root structure (C-compatible) and transmits only the C pointer c_loc(H) to the DLL.
    ! H itself contains C pointers to other substructures that describe the entire original HDF hierarchy.      

    character(kind=c_char), allocatable, target, save :: table_names_buf(:)
    character(kind=c_char), allocatable, target, save :: comp_names_buf(:)
    integer :: nb_tables, t, c, h1, h2, total_comps
    integer :: total_name_chars, total_vars_chars, total_comp_name_chars
    integer :: i, pos_name, pos_vars, pos_cname, idx
    integer :: first_idx
    character(:), allocatable :: txt

    nb_tables = size(h5%tbl_dsc)

    allocate(Tbls_c(nb_tables))
    allocate(vars_offset(nb_tables))
    allocate(n_vars_tbl(nb_tables))
    allocate(var_len_tbl(nb_tables))

    total_comps = 0
    do t = 1, nb_tables
        total_comps = total_comps + size(h5%tbl_dsc(t)%comps)
    end do
    allocate(Comps_c(total_comps))

    total_name_chars = 0
    do t = 1, nb_tables
        total_name_chars = total_name_chars + len(h5%tbl_dsc(t)%name) + 1
    end do
    allocate(table_names_buf(total_name_chars))

    total_vars_chars = 0
    do t = 1, nb_tables
        h1 = size(h5%tbl_dsc(t)%vars)
        n_vars_tbl(t) = h1
        var_len_tbl(t) = 0
        do i = 1, h1
            var_len_tbl(t) = max(var_len_tbl(t), len(h5%tbl_dsc(t)%vars(i)))
        end do
        total_vars_chars = total_vars_chars + n_vars_tbl(t)*var_len_tbl(t)
    end do
    allocate(vars_buf(total_vars_chars))

    total_comp_name_chars = 0
    do t = 1, nb_tables
        do c = 1, size(h5%tbl_dsc(t)%comps)
            total_comp_name_chars = total_comp_name_chars + &
                 len(h5%tbl_dsc(t)%comps(c)%p%name) + 1
        end do
    end do
    allocate(comp_names_buf(total_comp_name_chars))

    pos_name  = 1
    pos_vars  = 1
    pos_cname = 1
    idx       = 0

    do t = 1, nb_tables

        txt = h5%tbl_dsc(t)%name
        call make_c_string(txt, table_names_buf, pos_name, &
                           Tbls_c(t)%name_ptr, Tbls_c(t)%name_len)

        h1 = n_vars_tbl(t)
        Tbls_c(t)%n_vars   = h1
        Tbls_c(t)%var_len  = var_len_tbl(t)

        if (h1 > 0) then
            vars_offset(t) = pos_vars
            do i = 1, h1
                txt = h5%tbl_dsc(t)%vars(i)
                do c = 1, var_len_tbl(t)
                    if (c <= len(txt)) then
                        vars_buf(pos_vars + c - 1) = txt(c:c)
                    else
                        vars_buf(pos_vars + c - 1) = ' '
                    end if
                end do
                pos_vars = pos_vars + var_len_tbl(t)
            end do
            Tbls_c(t)%vars_ptr = c_loc(vars_buf(vars_offset(t)))
        else
            vars_offset(t)   = 0
            Tbls_c(t)%vars_ptr = c_null_ptr
        end if

        Tbls_c(t)%n_comps = size(h5%tbl_dsc(t)%comps)
        if (Tbls_c(t)%n_comps > 0) then
            first_idx = idx + 1

            do i = 1, Tbls_c(t)%n_comps
                idx = idx + 1

                txt = h5%tbl_dsc(t)%comps(i)%p%name
                call make_c_string(txt, comp_names_buf, pos_cname, &
                                   Comps_c(idx)%name_ptr, Comps_c(idx)%name_len)

                h2 = size(h5%tbl_dsc(t)%comps(i)%p%node_x)
                Comps_c(idx)%node_x_ptr = c_loc(h5%tbl_dsc(t)%comps(i)%p%node_x(1))
                Comps_c(idx)%n_node     = h2

                Comps_c(idx)%data_ptr = c_loc(h5%tbl_dsc(t)%comps(i)%p%data(1,1))         
                Comps_c(idx)%n1       = h2
                Comps_c(idx)%n2       = h1
            end do

            Tbls_c(t)%comps_ptr = c_loc(Comps_c(first_idx))
        else
            Tbls_c(t)%comps_ptr = c_null_ptr
        end if

    end do

    H%nb_tables  = nb_tables
    H%tables_ptr = c_loc(Tbls_c(1))

    h5_ptr = c_loc(H)
end subroutine expose_state_to_ext_library