module cubeadm_opened
  use cubetools_list
  use cubedag_parameters
  use cubedag_flag
  use cubedag_link_type
  use cubedag_node_type
  use cubedag_node
  use cubetuple_format
  use cube_types
  use cubetopology_cuberegion_types
  use cubeadm_cubeid_types
  use cubeadm_cubeprod_types
  use cubeadm_taskloop
  use cubeadm_messaging
  !---------------------------------------------------------------------
  ! Support module for registering and keep track of cubes opened by
  ! current command, up to the moment they are closed with
  ! 'cubeadm_finish_all'
  !---------------------------------------------------------------------
  !
  ! Keep a list of the parents and children currently 'opened'.
  ! At some point they are all 'flushed' in the DAG, with the proper
  ! cross-references.
  type(cubedag_link_t) :: pa  ! Parents list
  type(cubedag_link_t) :: ch  ! Children list
  !
  integer(kind=entr_k), parameter    :: min_alluser_alloc=16
  type(tools_list_t)                 :: allarg      ! Parents and children argument/product list
  character(len=argu_l), allocatable :: alluser(:)  ! Parents and children user inputs
  type(cubedag_link_t)               :: all         ! Parents and children cube list
  !
  integer(kind=code_k), parameter :: code_parent_noarg=1
  integer(kind=code_k), parameter :: code_parent=2
  integer(kind=code_k), parameter :: code_child=3
  integer(kind=code_k), parameter :: code_child_noprod=4
  !
  interface cubeadm_parents_add
    module procedure cubeadm_parents_add_noarg
    module procedure cubeadm_parents_add_witharg
  end interface cubeadm_parents_add
  !
  interface cubeadm_children_add
    module procedure cubeadm_children_add_noprod
    module procedure cubeadm_children_add_withprod
  end interface cubeadm_children_add
  !
  interface cubeadm_datainit_all
    module procedure cubeadm_datainit_allcubes_full
    module procedure cubeadm_datainit_allcubes_region
  end interface cubeadm_datainit_all
  !
  public :: cubeadm_parents_add,cubeadm_children_add
  public :: cubeadm_datainit_all,cubeadm_dataiterate_all,cubeadm_finish_all
  public :: cubeadm_iterator_t  ! For convenience to users
  public :: cubeadm_parents_children_pop, cubeadm_opened_list_size
  private
  !
contains
  !
  subroutine cubeadm_parents_add_noarg(dno,action)
    !-------------------------------------------------------------------
    ! Add a parent cube as command input
    ! ---
    ! This version does not provide a cubeid_arg_t nor a
    ! cubeid_user_cube_t
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), pointer    :: dno
    integer(kind=code_k),         intent(in) :: action
    !
    logical :: error,skip
    !
    error = .false.
    !
    ! Cube
    call cubeadm_parents_add_cube(dno,code_parent_noarg,action,skip,error)
    if (error)  return
    if (skip)  return
    !
    ! Argument/product => unknown with this API
    call allarg%realloc(allarg%n+1,error)
    if (error) return
    allarg%n = allarg%n+1
    call allarg%list(allarg%n)%nullify(error)
    if (error)  return
    !
    ! User input => unknown with this API
    call alluser_reallocate(allarg%n,error)
    if (error) return
    alluser(allarg%n) = ' '
  end subroutine cubeadm_parents_add_noarg
  !
  subroutine cubeadm_parents_add_witharg(arg,user,dno,action)
    !-------------------------------------------------------------------
    ! Add a parent cube as command input
    ! ---
    ! This version provides a cubeid_arg_t (for input cube expectations)
    ! and a cubeid_user_cube_t (for actual user inputs)
    !-------------------------------------------------------------------
    type(cubeid_arg_t),           intent(in) :: arg
    type(cubeid_user_cube_t),     intent(in) :: user
    class(cubedag_node_object_t), pointer    :: dno
    integer(kind=code_k),         intent(in) :: action
    !
    logical :: error,skip
    !
    error = .false.
    !
    ! Cube
    call cubeadm_parents_add_cube(dno,code_parent,action,skip,error)
    if (error)  return
    if (skip)  return
    !
    ! Argument/product
    call allarg%realloc(allarg%n+1,error)
    if (error) return
    allarg%n = allarg%n+1
    call allarg%list(allarg%n)%associate(arg,error)
    if (error)  return
    !
    ! User input
    call alluser_reallocate(allarg%n,error)
    if (error) return
    alluser(allarg%n) = user%id  ! Keep only the non-parsed string
  end subroutine cubeadm_parents_add_witharg
  !
  subroutine cubeadm_parents_add_cube(dno,code,action,skip,error)
    !-------------------------------------------------------------------
    ! Add a parent cube in the lists
    ! ---
    ! Do not call directly, use cubeadm_parents_add generic entry point
    ! instead
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), pointer       :: dno
    integer(kind=code_k),         intent(in)    :: code
    integer(kind=code_k),         intent(in)    :: action
    logical,                      intent(out)   :: skip
    logical,                      intent(inout) :: error
    !
    integer(kind=entr_k) :: ipa
    !
    ! Avoid double insertions. This can happen if a cube is re-accessed
    ! (cubeadm_access_header) during the command execution
    do ipa=1,pa%n
      if (associated(pa%list(pa%n)%p,dno)) then
        skip = .true.
        return
      endif
    enddo
    skip = .false.
    !
    ! Cube (in list of parents)
    call pa%reallocate(pa%n+1,error)
    pa%n = pa%n+1
    pa%list(pa%n)%p => dno
    pa%flag(pa%n) = action
    !
    ! Cube (in list of all cubes)
    call all%reallocate(all%n+1,error)
    all%n = all%n+1
    all%list(all%n)%p => dno
    all%flag(all%n) = code
  end subroutine cubeadm_parents_add_cube
  !
  !---------------------------------------------------------------------
  !
  subroutine cubeadm_children_add_noprod(dno,action)
    !-------------------------------------------------------------------
    ! Add a child cube as command output
    ! ---
    ! This version does not provide a cube_prod_t
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), pointer    :: dno
    integer(kind=code_k),         intent(in) :: action
    logical :: error
    !
    error = .false.
    !
    ! Argument/product => unknown with this API
    call allarg%realloc(allarg%n+1,error)
    if (error) return
    allarg%n = allarg%n+1
    call allarg%list(allarg%n)%nullify(error)
    if (error)  return
    !
    ! User input => irrelevant
    call alluser_reallocate(allarg%n,error)
    if (error) return
    alluser(allarg%n) = ' '
    !
    ! Cube
    call cubeadm_children_add_cube(dno,code_child_noprod,action)
  end subroutine cubeadm_children_add_noprod
  !
  subroutine cubeadm_children_add_withprod(prod,dno,action)
    !-------------------------------------------------------------------
    ! Add a child cube as command output
    ! ---
    ! This version does not provide a cube_prod_t
    !-------------------------------------------------------------------
    type(cube_prod_t),            intent(in) :: prod
    class(cubedag_node_object_t), pointer    :: dno
    integer(kind=code_k),         intent(in) :: action
    logical :: error
    !
    error = .false.
    !
    ! Argument/product
    call allarg%realloc(allarg%n+1,error)
    if (error) return
    allarg%n = allarg%n+1
    call allarg%list(allarg%n)%associate(prod,error)
    if (error)  return
    !
    ! User input => irrelevant
    call alluser_reallocate(allarg%n,error)
    if (error) return
    alluser(allarg%n) = ' '
    !
    ! Cube
    call cubeadm_children_add_cube(dno,code_child,action)
  end subroutine cubeadm_children_add_withprod
  !
  subroutine cubeadm_children_add_cube(dno,code,action)
    !-------------------------------------------------------------------
    ! Add a child cube in the lists
    ! ---
    ! Do not call directly, use cubeadm_children_add generic entry point
    ! instead
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), pointer    :: dno
    integer(kind=code_k),         intent(in) :: code
    integer(kind=code_k),         intent(in) :: action
    logical :: error
    !
    error = .false.
    !
    ! Cube (in list of children)
    call ch%reallocate(ch%n+1,error)
    ch%n = ch%n+1
    ch%list(ch%n)%p => dno
    ch%flag(ch%n) = action
    !
    ! Cube (in list of all cubes)
    call all%reallocate(all%n+1,error)
    all%n = all%n+1
    all%list(all%n)%p => dno
    all%flag(all%n) = code
  end subroutine cubeadm_children_add_cube
  !
  !---------------------------------------------------------------------
  !
  subroutine cubeadm_parents_children_pop(dno,error)
    use cubetools_list
    !-------------------------------------------------------------------
    ! Pop out the given node from the parents/children lists
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), pointer       :: dno
    logical,                      intent(inout) :: error
    !
    class(tools_object_t), pointer :: tot
    !
    tot => dno
    call pa%unlink(tot,error)
    call ch%unlink(tot,error)
    call all%unlink(tot,error)
    ! ZZZ For consistency these ones should be cleaned too (but they are
    ! only needed for feedback): allarg, alluser
  end subroutine cubeadm_parents_children_pop
  !
  subroutine cubeadm_parents_children_reset()
    logical :: error
    error = .false.
    call allarg%final(error)
    call pa%final(error)
    call ch%final(error)
    call all%final(error)
  end subroutine cubeadm_parents_children_reset
  !
  subroutine cubeadm_list_opened(error)
    use cubedag_list
    logical, intent(inout) :: error
    ! Local
    integer(kind=4) :: custom(20),larg,lflag,luser,nc
    character(len=mess_l) :: mess
    integer(kind=entr_k) :: icub
    integer(kind=code_k) :: status
    type(cubeid_arg_t), pointer :: arg
    type(cube_prod_t), pointer :: prod
    class(cubedag_node_object_t), pointer :: thiscube
    character(len=*), parameter :: cols(8) = &
         ['IDENTIFIER ','TYPE       ','FAMILY     ','FLAG       ',&
          'OBSERVATORY','SOURCE     ','LINE       ','DATASIZE   ']
    character(len=*), parameter :: rname='LIST>OPENED'
    !
    ! Set up trailing columns
    call cubeadm_opened_list_size(cols,custom,error)
    if (error) return
    !
    ! Automatic widths for leading columns
    larg = 1   ! Argument name width
    lflag = 1  ! Flag list width
    luser = 1  ! User input width
    do icub=1,all%n
      status = all%flag(icub)
      thiscube => cubedag_node_ptr(all%list(icub)%p,error)
      if (error) return
      select case (status)
      case (code_parent_noarg)  ! A parent with no associated cubeid_arg_t nor cubeid_user_cube_t
        ! Argument name size unchanged
        ! Flag column size unchanged
        ! User input column size unchanged
      case (code_parent)
        arg => cubeadm_cubeid_arg_ptr(allarg%list(icub)%p,error)
        if (error)  return
        ! Argument name size from command's cubeid_arg_t
        larg = max(larg,len_trim(arg%name))
        ! Flag column size from command's cubeid_arg_t
        call cubedag_flaglist_tostr(arg%flag,arg%nflag,lstrflag=nc,error=error)
        if (error) return
        lflag = max(lflag,nc)
        ! User input column size from user input
        luser = max(1,len_trim(alluser(icub)))
      case (code_child_noprod)
        ! Argument name size unchanged
        ! Flag column size from child cube itself
        call thiscube%node%flag%repr(lstrflag=nc,error=error)
        if (error) return
        lflag = max(lflag,nc)
        ! User input column size not changed (irrelevant)
      case (code_child)
        prod => cubeadm_cubeprod_ptr(allarg%list(icub)%p,error)
        if (error)  return
        ! Product name size from command's cube_prod_t
        larg = max(larg,len_trim(prod%name))
        ! Flag column size from command's cube_prod_t
        call cubedag_flaglist_tostr(prod%flag,prod%nflag,lstrflag=nc,error=error)
        if (error) return
        lflag = max(lflag,nc)
        ! User input column size not changed (irrelevant)
      case default
        call cubeadm_message(seve%w,rname,'Cube is neither parent nor child')
      end select
    enddo
    !
    ! Actual print
    do icub=1,all%n
      nc = 1
      status = all%flag(icub)
      thiscube => cubedag_node_ptr(all%list(icub)%p,error)
      if (error) return
      select case (status)
      case (code_parent_noarg)  ! A parent with no associated cubeid_arg_t nor cubeid_user_cube_t
        mess(nc:) = 'I'
        nc = nc+2
        mess(nc:) = ' '  ! No argument name
        nc = nc+larg+1
        mess(nc:) = ' '  ! No argument flags
        nc = nc+lflag+1
        mess(nc:) = ' '  ! No user input
        nc = nc+luser
      case (code_parent)
        arg => cubeadm_cubeid_arg_ptr(allarg%list(icub)%p,error)
        if (error)  return
        mess(nc:) = 'I'
        nc = nc+2
        mess(nc:) = arg%name
        nc = nc+larg+1
        call cubedag_flaglist_tostr(arg%flag,arg%nflag,strflag=mess(nc:),error=error)
        if (error) return
        nc = nc+lflag+1
        mess(nc:) = alluser(icub)
        nc = nc+luser
      case (code_child_noprod)
        mess(nc:) = 'O'
        nc = nc+2
        mess(nc:) = ' '  ! No argument name
        nc = nc+larg+1
        call thiscube%node%flag%repr(strflag=mess(nc:),error=error)
        if (error) return
        nc = nc+lflag+1
        mess(nc:) = alluser(icub)
        nc = nc+luser
      case (code_child)
        prod => cubeadm_cubeprod_ptr(allarg%list(icub)%p,error)
        if (error)  return
        mess(nc:) = 'O'
        nc = nc+2
        mess(nc:) = prod%name
        nc = nc+larg+1
        call cubedag_flaglist_tostr(prod%flag,prod%nflag,strflag=mess(nc:),error=error)
        if (error) return
        nc = nc+lflag+1
        mess(nc:) = alluser(icub)
        nc = nc+luser
      end select
      mess(nc:) = ' => '
      nc = nc+4
      call cubedag_list_one_custom(thiscube,custom,.true.,code_null,code_null,mess(nc:),error)
      if (error) return
      call cubeadm_message(seve%r,rname,mess)
    enddo
    !
  end subroutine cubeadm_list_opened
  !
  subroutine cubeadm_datainit_allcubes_full(iter,error)
    !-------------------------------------------------------------------
    ! Prepare the data IO for all the registered cubes
    !-------------------------------------------------------------------
    type(cubeadm_iterator_t), intent(out)   :: iter
    logical,                  intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='DATAINIT>ALLCUBES>FULLSET'
    type(cuberegion_prog_t), pointer :: region
    !
    region => null()
    call cubeadm_datainit_allcubes_do(iter,region,error)
    if (error) return
    !
  end subroutine cubeadm_datainit_allcubes_full
  !
  subroutine cubeadm_datainit_allcubes_region(iter,region,error)
    !-------------------------------------------------------------------
    ! Prepare the data IO for all the registered cubes
    !-------------------------------------------------------------------
    type(cubeadm_iterator_t),        intent(out)   :: iter
    type(cuberegion_prog_t), target, intent(in)    :: region
    logical,                         intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='DATAINIT>ALLCUBES>REGION'
    type(cuberegion_prog_t), pointer :: pregion
    !
    pregion => region
    call cubeadm_datainit_allcubes_do(iter,pregion,error)
    if (error) return
  end subroutine cubeadm_datainit_allcubes_region
  !
  subroutine cubeadm_datainit_allcubes_do(iter,region,error)
    use cubetools_access
    use cubeadm_entryloop
    !-------------------------------------------------------------------
    ! Prepare the data IO for all the registered cubes
    !-------------------------------------------------------------------
    type(cubeadm_iterator_t), intent(inout) :: iter
    type(cuberegion_prog_t),  pointer       :: region
    logical,                  intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='DATAINIT>ALLCUBES>DO'
    type(cube_t), pointer :: incube,oucube
    integer(kind=entr_k) :: icube,refnum
    integer(kind=code_k) ::refaccess,reforder
    character(len=mess_l) :: mess
    class(cubedag_node_object_t), pointer :: dno
    !
    ! Loop on all the input cubes to check their consistency
    refnum = 0
    do icube=1,pa%n
      if (pa%flag(icube).eq.code_read_head)  cycle  ! No need for data consistency check
      dno => cubedag_node_ptr(pa%list(icube)%p,error)
      if (error) return
      incube => cubetuple_cube_ptr(dno,error)
      if (error) return
      if (refnum.eq.0) then
        refnum = icube
        refaccess = incube%access()
        reforder = incube%order()
      else
        if (incube%order().ne.reforder .or. &
            incube%access().ne.refaccess) then
          call cubeadm_message(seve%e,rname,'Inconsistent cube accesses or orders:')
          write(mess,'(A,I0,4A)')  '  Cube #',refnum,  &
                                   ': access ',trim(cubetools_accessname(refaccess)),  &
                                   ', order ',cubetools_ordername(reforder)
          call cubeadm_message(seve%e,rname,mess)
          write(mess,'(A,I0,4A)')  '  Cube #',icube,  &
                                   ': access ',trim(cubetools_accessname(incube%access())),  &
                                   ', order ',cubetools_ordername(incube%order())
          call cubeadm_message(seve%e,rname,mess)
          error = .true.
          return
        endif
      endif
    enddo
    !
    ! Loop on all the output cubes to prepare them for data access
    do icube=1,ch%n
      dno => cubedag_node_ptr(ch%list(icube)%p,error)
      if (error) return
      oucube => cubetuple_cube_ptr(dno,error)
      if (error) return
      call cubeadm_datainit_one(oucube,error)
      if (error) return
    enddo
    !
    ! Taskloop iterator is set by taking all the input and output cubes
    ! into account
    call cubeadm_taskloop_init(pa,ch,region,iter,error)
    if (error) return
    ! Entryloop iterator
    call cubeadm_entryloop_init(iter%ne,error)
    if (error) return
    !
    ! Initialize processing
    do icube=1,ch%n
      dno => cubedag_node_ptr(ch%list(icube)%p,error)
      if (error) return
      oucube => cubetuple_cube_ptr(dno,error)
      if (error) return
      call cubeadm_processinginit_one(oucube,iter%nt,error)
      if (error) return
    enddo
    !
    ! User feedback (after the output cubes have been prepared)
    call cubeadm_list_opened(error)
    if (error) return
  end subroutine cubeadm_datainit_allcubes_do
  !
  subroutine cubeadm_datainit_one(oucube,error)
    use cubeio_interfaces_public
    use cubeadm_import
    !-------------------------------------------------------------------
    ! Prepare the data IO for one cube
    !-------------------------------------------------------------------
    type(cube_t), intent(inout) :: oucube
    logical,      intent(inout) :: error
    !
    ! Prepare HGDF and the descriptor (the later is needed between now
    ! and first data access)
    ! ZZZ RENAME THIS SUBROUTINE
    call cubeio_clone_cube_header(oucube%user,oucube%prog,oucube%head,oucube%tuple%current,error)
    if (error) return
    !
    call cubeadm_head_to_node(oucube%head,oucube,error)
    if (error) return
    !
  end subroutine cubeadm_datainit_one
  !
  subroutine cubeadm_processinginit_one(oucube,ntasks,error)
    use cubetools_header_methods
    !-------------------------------------------------------------------
    ! Prepare the processing for one cube
    !-------------------------------------------------------------------
    type(cube_t),         intent(inout) :: oucube
    integer(kind=entr_k), intent(in)    :: ntasks
    logical,              intent(inout) :: error
    !
    if (.not.oucube%user%output%extrema .or. oucube%iscplx())  return
    !
    ! Re-initialize the extrema since they are about to be recomputed
    ! in the upcoming processing loop (OBSOLESCENT)
    ! BEWARE: ndat is also computed below
    call cubetools_header_extrema_init(oucube%head,error)
    if (error) return
    !
    ! Re-initialize the per-task extrema since they are about to be
    ! recomputed in the upcoming processing loop
    call oucube%proc%allocate_extrema(oucube%head,ntasks,error)
    if (error)  return
  end subroutine cubeadm_processinginit_one
  !
  function cubeadm_dataiterate_all(iter,error)
    !-------------------------------------------------------------------
    ! Iterate the iterator until all data is processed, and ensure all
    ! the registered cubes are ready to access their first to last
    ! entries.
    !-------------------------------------------------------------------
    logical :: cubeadm_dataiterate_all
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    ! Local
    integer(kind=entr_k) :: icube
    class(cubedag_node_object_t), pointer :: dno
    !
    ! Iteration
    cubeadm_dataiterate_all = cubeadm_taskloop_iterate(iter,error)
    if (error) return
    if (.not.cubeadm_dataiterate_all)   return  ! All done
    !
    ! Parents
    do icube=1,pa%n
      if (pa%flag(icube).eq.code_read .or.  &
          pa%flag(icube).eq.code_update) then  ! Skip parent which is code_read_head
        dno => cubedag_node_ptr(pa%list(icube)%p,error)
        if (error) return
        call cubeadm_dataiterate_one(iter%ifp,iter%ilp,dno,error)
        if (error) return
      endif
    enddo
    !
    ! Children
    do icube=1,ch%n
      dno => cubedag_node_ptr(ch%list(icube)%p,error)
      if (error) return
      call cubeadm_dataiterate_one(iter%ofp,iter%olp,dno,error)
      if (error) return
    enddo
    !
  end function cubeadm_dataiterate_all
  !
  subroutine cubeadm_dataiterate_one(firstplane,lastplane,dno,error)
    use cubeadm_ioloop
    !-------------------------------------------------------------------
    ! Ensure the identified cube is ready to access its iter%first to
    ! iter%last entries.
    !-------------------------------------------------------------------
    integer(kind=data_k),         intent(in)    :: firstplane
    integer(kind=data_k),         intent(in)    :: lastplane
    class(cubedag_node_object_t), pointer       :: dno
    logical,                      intent(inout) :: error
    ! Local
    type(cube_t), pointer :: cube
    character(len=*), parameter :: rname='DATAITERATE>ONE'
    !
    cube => cubetuple_cube_ptr(dno,error)
    if (error) return
    call cubeadm_io_iterate_planes(firstplane,lastplane,cube,error)
    if (error) return
  end subroutine cubeadm_dataiterate_one
  !
  subroutine cubeadm_finish_all(comm,line,error)
    use cubedag_dag
    use cubedag_history
    use cubeadm_import
    !---------------------------------------------------------------------
    ! Finish all cubes currently opened in index.
    ! ---
    ! Beware this subroutine can be called in an error recovery context,
    ! i.e. with error = .true. on input
    !---------------------------------------------------------------------
    character(len=*), intent(in)    :: comm
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='FINISH>ALL'
    integer(kind=entr_k) :: ient,hid
    logical :: lerror
    class(cubedag_node_object_t), pointer :: dno
    !
    lerror = .false.  ! Local error
    !
    ! Insert in history
    if (.not.error) then
      ! If you plan to put failed commands in the HISTORY list,
      ! you can not reference output cubes ('ch' list) which are
      ! not inserted in DAG but destroyed instead.
      call cubedag_history_add_tohx(comm,line,pa,ch,hid,lerror)
      if (lerror) continue
    endif
    !
    if (.not.error) then
      ! Update the links between parents and children, according to their read/write
      ! status. This is to be done before the cubes are freed (finalized)
      call cubedag_node_links(pa,ch,hid,lerror)
      if (lerror) continue
    endif
    !
    ! Deal with the input cubes (including cubes opened in UPDATE mode, needing
    ! to be written on disk).
    do ient=1,pa%n
      dno => cubedag_node_ptr(pa%list(ient)%p,lerror)
      if (lerror) exit
      call cubeadm_finish_one(dno,lerror)
      if (lerror) exit
    enddo
    !
    ! Deal with the output cubes
    do ient=1,ch%n
      dno => cubedag_node_ptr(ch%list(ient)%p,lerror)
      if (lerror) exit
      call cubeadm_finish_one(dno,lerror)
      if (lerror) exit
      if (error) then
        call cubedag_node_destroy(dno,lerror)
        if (lerror) exit
      else
        call cubedag_dag_attach(dno,lerror)
        if (lerror) exit
      endif
    enddo
    !
    ! Reset parents and children list
    call cubeadm_parents_children_reset()
    !
    ! Ensure the ID counter is up-to-date (in particular if an error
    ! occured, i.e. the output cubes were discarded)
    call cubedag_dag_updatecounter(lerror)
    if (lerror) continue
    !
    if (lerror) error = .true.
    !
  end subroutine cubeadm_finish_all
  !
  subroutine cubeadm_finish_one(format,error)
    use cubeadm_timing
    !-------------------------------------------------------------------
    ! Finish one cube given its id
    ! ---
    ! Beware this subroutine can be called in an error recovery context
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(inout) :: format
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='FINISH>ONE'
    !
    if (error) return  ! Error recovery: we should probably do some cleaning below!
    !
    select type (format)
    class is (format_t)
      call format%finish(error)
      if (error) continue
      call format%dag_upsert(error)
      if (error) continue
      call cubeadm_timing_collect_io(format)
      ! Always free the GIO slot, which is a limited ressource. The other
      ! ressources are handled by the GC
      call format%close(error)
      if (error) return
    type is (cubedag_node_object_t)
      ! For the root object which is sometimes the parent node
      continue
    class default
      call cubeadm_message(seve%e,rname,'Object has wrong type')
      error = .true.
      return
    end select
  end subroutine cubeadm_finish_one
  !
  subroutine alluser_reallocate(nuser,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    integer(kind=list_k), intent(in)    :: nuser
    logical,              intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='ALLUSER>REALLOCATE'
    character(len=argu_l), allocatable :: tmp(:)
    integer(kind=entr_k) :: oldsize,newsize
    integer(kind=4) :: ier
    !
    if (allocated(alluser)) then
      oldsize = size(alluser)
      if (oldsize.ge.nuser)  return
      allocate(tmp(oldsize),stat=ier)
      if (failed_allocate(rname,'tmp',ier,error)) return
      tmp(:) = alluser(:)
      deallocate(alluser)
      newsize = max(min_alluser_alloc,2*oldsize)
    else
      newsize = min_alluser_alloc
    endif
    !
    allocate(alluser(newsize),stat=ier)
    if (failed_allocate(rname,'alluser',ier,error)) return
    if (allocated(tmp)) then
      alluser(1:oldsize) = tmp(:)
      deallocate(tmp)
    endif
  end subroutine alluser_reallocate
  !
  subroutine cubeadm_opened_list_size(ucols,custom,error)
    use cubedag_list
    !----------------------------------------------------------------------
    ! Defines de size and columns of a list from a list of columns
    ! based on the currently opened cubes
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: ucols(:)
    integer(kind=4),  intent(out)   :: custom(20)
    logical,          intent(inout) :: error
    !
    integer(kind=4) :: ukeys(20),ncol
    character(len=*), parameter :: rname='OPENED>LIST>SIZE'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    ncol = size(ucols)
    call cubedag_list_columns_parse(ncol,ucols,ukeys,error)
    if (error) return
    call cubedag_list_columns_set(ukeys,custom,error)
    if (error) return
    call cubedag_list_link_widths(all,custom,error)
    if (error) return
  end subroutine cubeadm_opened_list_size
end module cubeadm_opened
