!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeedit_opened_types
  use cubetools_parameters
  use cubelist_types
  use cube_types
  use cubeedit_messaging
  !
  public :: undetermined_dim
  public :: opened
  private
  !
  integer(kind=list_k), parameter :: not_found = -1
  integer(kind=entr_k), parameter :: undetermined_dim = -2
  integer(kind=4),      parameter :: root_id = 0
  !
  type, extends(list_object_t) :: opened_object_t
     integer(kind=4),       private :: inputid        ! Numeric id of input cube
     character(len=varn_l), private :: editedid       ! Cube id during editing
     type(cube_t), pointer, private :: cube => null() ! The edited cube
     integer(kind=code_k),  private :: access         ! Access order
     integer(kind=entr_k),  private :: ie             ! Current cube entry
     logical,               private :: new            ! Is the cube created from scratch?
   contains
     ! Command actions
     procedure, private :: open    => cubeedit_opened_object_open
     procedure, private :: close   => cubeedit_opened_object_close
     procedure, private :: abort   => cubeedit_opened_object_abort
     procedure, private :: glimpse => cubeedit_opened_object_glimpse
     ! Internal actions
     procedure, private :: create    => cubeedit_opened_object_create
     procedure, private :: resize    => cubeedit_opened_object_resize
     procedure, private :: init_data => cubeedit_opened_object_init_data
     procedure, private :: list      => cubeedit_opened_object_list
     procedure, public  :: final     => cubeedit_opened_object_final
  end type opened_object_t
  !
  type, extends(list_t) :: opened_list_t
   contains
     ! Command actions
     procedure, public  :: listing => cubeedit_opened_list_list
     procedure, public  :: open    => cubeedit_opened_list_open
     procedure, public  :: close   => cubeedit_opened_list_close
     procedure, public  :: abort   => cubeedit_opened_list_abort
     procedure, public  :: glimpse => cubeedit_opened_list_glimpse
     ! Internal actions
     procedure, public  :: create           => cubeedit_opened_list_create
     procedure, public  :: get_editedid     => cubeedit_opened_list_get_editedid
     procedure, public  :: get_cube_pointer => cubeedit_opened_list_get_cube_pointer
     procedure, public  :: get_cube_entry   => cubeedit_opened_list_get_cube_entry
     procedure, public  :: set_cube_entry   => cubeedit_opened_list_set_cube_entry
     procedure, private :: find             => cubeedit_opened_list_find
     generic,   private :: get_ptr          => get_ptr_byname,get_ptr_bynum
     procedure, private :: get_ptr_byname   => cubeedit_opened_object_ptr_byname
     procedure, private :: get_ptr_bynum    => cubeedit_opened_object_ptr_bynum
  end type opened_list_t
  type(opened_list_t) :: opened
  !
contains
  !
  subroutine cubeedit_opened_object_final(obj,error)
    !----------------------------------------------------------------------
    ! Finalize a buffer
    !----------------------------------------------------------------------
    class(opened_object_t), intent(inout) :: obj
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='CUBE>BUFFER>FINAL'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    obj%cube => null()
    obj%editedid = ''
  end subroutine cubeedit_opened_object_final
  !
  subroutine cubeedit_opened_object_open(buffer,buffprod,likearg,likeid,access,  &
    dims,doinit,initval,name,error)
    use cubetools_structure
    use cubedag_node_class
    use cubedag_dag_buffer
    use cubeadm_cubeid_types
    use cubeadm_cubeprod_types
    use cubeadm_clone
    use cubeadm_get
    use cubeadm_opened
    use cubeadm_copy_tool
    !----------------------------------------------------------------------
    ! Open a cube in a buffer, resize it and initialize it if need be
    !----------------------------------------------------------------------
    class(opened_object_t), intent(out)   :: buffer
    type(cube_prod_t),      intent(in)    :: buffprod
    type(cubeid_arg_t),     intent(in)    :: likearg
    type(cubeid_user_t),    intent(in)    :: likeid
    integer(kind=code_k),   intent(in)    :: access
    integer(kind=entr_k),   intent(in)    :: dims(3)
    logical,                intent(in)    :: doinit
    real(kind=sign_k),      intent(in)    :: initval
    character(len=*),       intent(in)    :: name
    logical,                intent(inout) :: error
    !
    type(cube_t), pointer :: ref
    logical :: modified_dims
    class(cubedag_node_object_t), pointer :: dno
    character(len=*), parameter :: rname='CUBE>BUFFER>OPEN'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    buffer%access = access
    buffer%editedid = name
    modified_dims = any(dims.ne.undetermined_dim)
    buffer%ie = 0
    buffer%new = .false.
    !
    if (modified_dims) then
       call cubeadm_get_header(likearg,likeid,ref,error,  &
         access=buffer%access,action=code_read_head)
       if (error) return
       call cubeadm_clone_header(buffprod,ref,buffer%cube,error)
       if (error) return
       call cubedag_dag_nullid(buffer%cube%node%id)
       call buffer%resize(dims,error)
       if (error) return
       call buffer%init_data(initval,error)
       if (error) return
    else
       if (doinit) then
          call cubeadm_get_header(likearg,likeid,ref,error,  &
            access=buffer%access,action=code_read_head)
          if (error) return
          call cubeadm_clone_header(buffprod,ref,buffer%cube,error)
          if (error) return
          call cubedag_dag_nullid(buffer%cube%node%id)
          call buffer%init_data(initval,error)
          if (error) return
       else
          ! Header part:
          ! Here cubeadm_get_header prepares the transposition if relevant.
          ! The cube to be used in the tuple is set to the imaset or speset
          ! at this stage, but in case of transposition its data is not yet
          ! ready.
          call cubeadm_get_header(likearg,likeid,ref,error,  &
            access=buffer%access,action=code_read)
          if (error) return
          call cubeadm_clone_header(buffprod,ref,buffer%cube,error)
          if (error) return
          call cubedag_dag_nullid(buffer%cube%node%id)
          ! Data part
          ! First apply transposition on the input cube if needed
          call ref%autotranspose(error)
          if (error) return
          ! Now switch the input cube to subset access
          call cubeadm_access_header(ref,code_access_subset,code_read,error)
          if (error) return
          ! And copy its data in subset access
          call cubeadm_copy_data(ref,buffer%cube,error)
          if (error) return
       endif
    endif
    ! All or part copied from likearg => inherit as child
    buffer%inputid = ref%node%id
    !
    ! Prepare extrema processing. Assume no parallel put involved (1 pseudo-task)
    ! ZZZ Should this be merged at clone_header time, knowing that most of all
    !     the other commands will reallocate with the proper number of tasks?
    call buffer%cube%proc%allocate_extrema(buffer%cube%head,1,error)
    if (error) return
    !
    ! Unreference the output cube from the 'opened' ones, so that it is left
    ! "opened" in memory and not yet inserted in DAG. See symetric action
    ! in cubeedit_opened_object_close. The cube will be properly finalized and
    ! inserted at that moment.
    dno => buffer%cube
    call cubeadm_parents_children_pop(dno,error)
    if (error) return
  end subroutine cubeedit_opened_object_open
  !
  subroutine cubeedit_opened_object_create(buffer,access,dims,initval,name,error)
    use cubedag_allflags
    use cubedag_node_class
    use cubedag_dag_buffer
    use cubeadm_create
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! Create a cube buffer from scratch and initialize it
    !----------------------------------------------------------------------
    class(opened_object_t), intent(out)   :: buffer
    integer(kind=code_k),   intent(in)    :: access
    integer(kind=entr_k),   intent(in)    :: dims(3) ! *** JP it should be of type integer(kind=data_k)
    real(kind=sign_k),      intent(in)    :: initval
    character(len=*),       intent(in)    :: name
    logical,                intent(inout) :: error
    !
    integer(kind=ndim_k) :: ndim
    integer(kind=data_k) :: mydims(maxdim)
    class(cubedag_node_object_t), pointer :: dno
    character(len=*), parameter :: rname='CUBE>BUFFER>OPEN'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    buffer%access = access
    buffer%editedid = name
    buffer%ie = 0
    buffer%inputid = root_id
    buffer%new = .true.
    !
    ndim = 3
    mydims(1:3)      = dims
    mydims(4:maxdim) = 0
    call cubeadm_create_header([flag_edit,flag_cube],access,ndim,mydims,buffer%cube,error)
    if (error) return
    ! *** JP: Does the order matters after this point?
    call cubedag_dag_nullid(buffer%cube%node%id)
    call buffer%init_data(initval,error)
    if (error) return
    !
    ! Prepare extrema processing. Assume no parallel put involved (1 pseudo-task)
    ! ZZZ Should this be merged at create_header time, knowing that most of all
    !     the other commands will reallocate with the proper number of tasks?
    call buffer%cube%proc%allocate_extrema(buffer%cube%head,1,error)
    if (error) return
    !
    ! Unreference the output cube from the 'opened' ones, so that it is left
    ! "opened" in memory and not yet inserted in DAG. See symetric action
    ! in cubeedit_opened_object_close. The cube will be properly finalized and
    ! inserted at that moment.
    dno => buffer%cube
    call cubeadm_parents_children_pop(dno,error)
    if (error) return
  end subroutine cubeedit_opened_object_create
  !
  subroutine cubeedit_opened_object_glimpse(buffer,error)
    use cubetools_header_types
    !----------------------------------------------------------------------
    ! Glimpse the edited cube header
    !----------------------------------------------------------------------
    class(opened_object_t), intent(in)    :: buffer
    logical,                intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='CUBE>BUFFER>GLIMPSE'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call cubeedit_message(seve%r,rname,'')
    write(mess,'(a,24x,a,4x,a,x,a)') 'Editing Id','Access','Orig Id','Entry'
    call cubeedit_message(seve%r,rname,mess)
    call buffer%list(mess,error)
    if (error) return
    call cubeedit_message(seve%r,rname,mess)
    call cubeedit_message(seve%r,rname,'')
    call buffer%cube%head%list(error)
    if (error) return
  end subroutine cubeedit_opened_object_glimpse
  !
  subroutine cubeedit_opened_object_abort(buffer,error)
    use cubedag_node_class
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! Abort buffer edition
    !----------------------------------------------------------------------
    class(opened_object_t), intent(inout) :: buffer
    logical,                intent(inout) :: error
    !
    class(cubedag_node_object_t), pointer :: dno
    logical :: lerror
    character(len=*), parameter :: rname='CUBE>BUFFER>ABORT'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    ! call cubeadm_parents_add(root,code_read)
    dno => buffer%cube
    call cubeadm_children_add(dno,code_write)
    !
    ! Explicit call of cubeadm_finish_all with error=.true. will ensure
    ! the cube is destroyed instead of attached in DAG
    lerror = .true.
    call cubeadm_finish_all('ABORT','ABORT',lerror)
  end subroutine cubeedit_opened_object_abort
  !
  subroutine cubeedit_opened_object_close(buffer,newname,error)
    use gkernel_interfaces
    use cubedag_node_class
    use cubedag_dag_buffer
    use cubetools_flag_types
    use cubeadm_opened
    use cubetools_cubeid_types
    !----------------------------------------------------------------------
    ! Close buffer edition
    !----------------------------------------------------------------------
    class(opened_object_t), intent(inout) :: buffer
    character(len=*),       intent(in)    :: newname
    logical,                intent(inout) :: error
    !
    class(cubedag_node_object_t), pointer :: dno
    character(len=file_l) :: family
    type(flag_t), allocatable :: flags(:)
    character(len=*), parameter :: rname='CUBE>BUFFER>CLOSE'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call cubedag_dag_newid(buffer%cube%node%id)
    !
    ! Family + flags
    call cubetools_cubeid_string2familyflags(newname,family,flags,error)
    if (error) return
    call buffer%cube%set_value('FAMILY',family,error)
    if (error) return
    if (allocated(flags)) then
      ! Apply the user-defined flags
      call buffer%cube%set_flags(flags,error)
      if (error) return
    else
      ! Let flags as they were created at clone/create time
    endif
    !
    call buffer%cube%set_header(buffer%cube%head,error)
    if (error) return
    !
    ! Add parent
    call cubedag_dag_get_object(buffer%inputid,dno,error)
    if (error) return
    call cubeadm_parents_add(dno,code_read)
    ! Add child
    dno => buffer%cube
    call cubeadm_children_add(dno,code_write)
  end subroutine cubeedit_opened_object_close
  !
  subroutine cubeedit_opened_object_list(buffer,mess,error)
    !----------------------------------------------------------------------
    ! Return a message containing a summary of the buffer
    !----------------------------------------------------------------------
    class(opened_object_t), intent(in)    :: buffer
    character(len=mess_l),  intent(out)   :: mess
    logical,                intent(inout) :: error
    !
    character(len=8) :: access,cubeid
    character(len=*), parameter :: rname='CUBE>BUFFER>LIST'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    if (buffer%access.eq.code_access_speset) then
       access = 'Spectrum'
    else if (buffer%access.eq.code_access_imaset) then
       access = 'Image'
    else
       access = strg_unk
    endif
    if (buffer%inputid.eq.root_id) then
       cubeid = 'New'
    else
       write(cubeid,'(i0)') buffer%inputid
    endif
    write(mess,'(a32,2(a10),i0)') buffer%editedid,access,cubeid,buffer%ie
  end subroutine cubeedit_opened_object_list
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeedit_opened_object_resize(buffer,dims,error)
    use cubetools_axis_types
    use cubetools_header_methods
    use cubetools_unit
    !----------------------------------------------------------------------
    ! Resize a cube buffer to dims. Ensure that the reference value
    ! keeps the same place on axis when the dimensions are identical
    ! to handle the /LIKE case. Else puts it at the axis center
    !----------------------------------------------------------------------
    class(opened_object_t), intent(inout) :: buffer
    integer(kind=entr_k),   intent(in)    :: dims(3)
    logical,                intent(inout) :: error
    !
    type(axis_t) :: laxis,maxis,caxis
    character(len=*), parameter :: rname='CUBE>BUFFER>RESIZE'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call cubetools_header_get_axis_head_l(buffer%cube%head,laxis,error)
    if (error) return
    call cubetools_header_get_axis_head_m(buffer%cube%head,maxis,error)
    if (error) return
    call cubetools_header_get_axis_head_c(buffer%cube%head,caxis,error)
    if (error) return
    if (laxis%n.ne.dims(1)) laxis%ref = laxis%n/2.+1
    if (maxis%n.ne.dims(2)) maxis%ref = maxis%n/2.+1
    if (caxis%n.ne.dims(3)) caxis%ref = caxis%n/2.+1
    laxis%n = dims(1)
    maxis%n = dims(2)
    caxis%n = dims(3)
    call cubetools_header_update_axset_l(laxis,buffer%cube%head,error)
    if (error) return
    call cubetools_header_update_axset_m(maxis,buffer%cube%head,error)
    if (error) return
    if (caxis%kind.eq.code_unit_freq) then
       call cubetools_header_update_frequency_from_axis(caxis,buffer%cube%head,error)
       if (error) return
    else if (caxis%kind.eq.code_unit_velo) then
       call cubetools_header_update_velocity_from_axis(caxis,buffer%cube%head,error)
       if (error) return
    else
       call cubetools_header_update_axset_c(caxis,buffer%cube%head,error)
       if (error) return
       call cubeedit_message(seve%w,rname,'Unknown kind of Spectral axis')
    endif
  end subroutine cubeedit_opened_object_resize
  !
  subroutine cubeedit_opened_object_init_data(buffer,initval,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! Initialize a cube buffer to a value
    !
    ! *** JP: This kind of operation should always be done per subcube.
    !
    !----------------------------------------------------------------------
    class(opened_object_t), intent(inout) :: buffer
    real(kind=sign_k),      intent(in)    :: initval
    logical,                intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    integer(kind=code_k) :: order
    character(len=*), parameter :: rname='CUBE>BUFFER>INIT>DATA'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    order = buffer%cube%order()
    !$OMP PARALLEL DEFAULT(none) SHARED(order,buffer,initval,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))
       if (error) exit
       !$OMP TASK SHARED(order,buffer,initval,error) FIRSTPRIVATE(iter)
       if (.not.error) then
          select case (order)
          case (code_cube_imaset)
             call cubeedit_opened_object_data_init_imag(buffer%cube,initval,iter,error)
          case (code_cube_speset)
             call cubeedit_opened_object_data_init_spec(buffer%cube,initval,iter,error)
          end select
       endif
       !$OMP END TASK
    enddo ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubeedit_opened_object_init_data
  !
  subroutine cubeedit_opened_object_data_init_spec(cube,initval,iter,error)
    use cubeadm_taskloop
    use cubeadm_spectrum_types
    !----------------------------------------------------------------------
    ! Initialize a speset cube buffer to a value
    !----------------------------------------------------------------------
    type(cube_t),             pointer       :: cube
    real(kind=sign_k),        intent(in)    :: initval
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(spectrum_t) :: spe
    character(len=*), parameter :: rname='CUBE>BUFFER>DATA>INIT>SPEC'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call spe%allocate('spectral buffer',cube,iter,error)
    if (error) return
    call spe%y%set(initval,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
      call spe%put(iter%ie,error)
      if (error) return
    enddo ! ie
  end subroutine cubeedit_opened_object_data_init_spec
  !
  subroutine cubeedit_opened_object_data_init_imag(cube,initval,iter,error)
    use cubeadm_taskloop
    use cubeadm_image_types
    !----------------------------------------------------------------------
    ! Initialize a speset cube buffer to a value
    !----------------------------------------------------------------------
    type(cube_t),             pointer       :: cube
    real(kind=sign_k),        intent(in)    :: initval
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(image_t) :: ima
    character(len=*), parameter :: rname='CUBE>BUFFER>DATA>INIT>IMAG'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call ima%allocate('image buffer',cube,iter,error)
    if (error) return
    call ima%set(initval,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
      call ima%put(iter%ie,error)
      if (error) return
    enddo ! ie
  end subroutine cubeedit_opened_object_data_init_imag
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeedit_opened_list_find(list,name,found,error)
    !----------------------------------------------------------------------
    ! Loop through the list to look for a opened cube with name 
    !----------------------------------------------------------------------
    class(opened_list_t), intent(in)    :: list
    character(len=*),     intent(in)    :: name 
    integer(kind=list_k), intent(out)   :: found
    logical,              intent(inout) :: error
    !
    integer(kind=list_k) :: ibuff
    type(opened_object_t), pointer :: buffer
    character(len=*), parameter :: rname='OPENED>LIST>FIND'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    if (name.eq.strg_star) then
       if (list%n.gt.0) then
         found = list%n
       else
         found = not_found
       endif
    else
       found = not_found
       do ibuff=1, list%n
          buffer => list%get_ptr(ibuff,error)
          if (error) return
          if (buffer%editedid.eq.name) then
             found = ibuff
             return
          endif
       enddo
    endif
  end subroutine cubeedit_opened_list_find
  !
  subroutine cubeedit_opened_list_open(list,name,buffprod,likearg,likeid,access,  &
    dims,doinit,init,error)
    use cubetools_structure
    use cubeadm_cubeid_types
    use cubeadm_cubeprod_types
    !----------------------------------------------------------------------
    ! Open a new buffer in buffer list
    !----------------------------------------------------------------------
    class(opened_list_t), intent(inout) :: list
    character(len=*),     intent(in)    :: name
    type(cube_prod_t),    intent(in)    :: buffprod
    type(cubeid_arg_t),   intent(in)    :: likearg
    type(cubeid_user_t),  intent(in)    :: likeid
    integer(kind=code_k), intent(in)    :: access
    integer(kind=entr_k), intent(in)    :: dims(3)
    logical,              intent(in)    :: doinit
    real(kind=sign_k),    intent(in)    :: init
    logical,              intent(inout) :: error
    !
    integer(kind=list_k) :: found
    type(opened_object_t), pointer :: buffer
    type(opened_object_t) :: template
    class(list_object_t), pointer :: lot
    character(len=*), parameter :: rname='OPENED>LIST>OPEN'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call list%find(name,found,error)
    if (error) return
    !
    if (found.ne.not_found) then
       call cubeedit_message(seve%e,rname,'There is already an opened cube&
            & with identifier '//name)
       error = .true.
       return
    endif
    !
    call list%allocate(template,lot,error)
    if (error) return
    buffer => list%get_ptr(list%n,error)
    if (error) return
    call buffer%open(buffprod,likearg,likeid,access,dims,doinit,init,name,error)
    if (error) return
  end subroutine cubeedit_opened_list_open
  !
  subroutine cubeedit_opened_list_create(list,name,access,dims,init,error)
    !----------------------------------------------------------------------
    ! Create a new buffer in buffer list
    !----------------------------------------------------------------------
    class(opened_list_t), intent(inout) :: list
    character(len=*),     intent(in)    :: name
    integer(kind=code_k), intent(in)    :: access
    integer(kind=entr_k), intent(in)    :: dims(3)
    real(kind=sign_k),    intent(in)    :: init
    logical,              intent(inout) :: error
    !
    integer(kind=list_k) :: found
    type(opened_object_t), pointer :: buffer
    type(opened_object_t) :: template
    class(list_object_t), pointer :: lot
    character(len=*), parameter :: rname='OPENED>LIST>CREATE'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call list%find(name,found,error)
    if (error) return
    !
    if (found.ne.not_found) then
       call cubeedit_message(seve%e,rname,'There is already an opened cube&
            & with identifier '//name)
       error = .true.
       return
    endif
    !
    call list%allocate(template,lot,error)
    if (error) return
    buffer => list%get_ptr(list%n,error)
    if (error) return
    call buffer%create(access,dims,init,name,error)
    if (error) return
  end subroutine cubeedit_opened_list_create
  !
  subroutine cubeedit_opened_list_glimpse(list,name,error)
    !----------------------------------------------------------------------
    ! Glimpse the header of a cube being edited if found
    !----------------------------------------------------------------------
    class(opened_list_t), intent(inout) :: list
    character(len=*),     intent(in)    :: name 
    logical,              intent(inout) :: error
    !
    type(opened_object_t), pointer :: buffer
    character(len=*), parameter :: rname='OPENED>LIST>GLIMPSE'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    buffer => list%get_ptr(name,error)
    if (error) return
    call buffer%glimpse(error)
    if (error) return
  end subroutine cubeedit_opened_list_glimpse
  !
  subroutine cubeedit_opened_list_abort(list,name,error)
    !----------------------------------------------------------------------
    ! Abort the edition of a cube if found
    !----------------------------------------------------------------------
    class(opened_list_t), intent(inout) :: list
    character(len=*),     intent(in)    :: name 
    logical,              intent(inout) :: error
    !
    integer(kind=list_k) :: found
    type(opened_object_t), pointer :: buffer
    character(len=*), parameter :: rname='OPENED>LIST>ABORT'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call list%find(name,found,error)
    if (error) return
    !
    if (found.eq.not_found) then
       call cubeedit_message(seve%e,rname,trim(name)//' is not currently open')
       error = .true.
       return
    endif
    !
    buffer => list%get_ptr(found,error)
    if (error) return
    call buffer%abort(error)
    if (error) return
    call list%pop(found,error)
    if (error) return
  end subroutine cubeedit_opened_list_abort
  !
  subroutine cubeedit_opened_list_close(list,name,newname,error)
    !----------------------------------------------------------------------
    ! Close the edition of a cube if found
    !----------------------------------------------------------------------
    class(opened_list_t), intent(inout) :: list
    character(len=*),     intent(in)    :: name
    character(len=*),     intent(in)    :: newname
    logical,              intent(inout) :: error
    !
    integer(kind=list_k) :: found
    type(opened_object_t), pointer :: buffer
    character(len=*), parameter :: rname='OPENED>LIST>CLOSE'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call list%find(name,found,error)
    if (error) return
    !
    if (found.eq.not_found) then
       call cubeedit_message(seve%e,rname,trim(name)//' is not currently open')
       error = .true.
       return
    endif
    !
    buffer => list%get_ptr(found,error)
    if (error) return
    call buffer%close(newname,error)
    if (error) return
    call list%pop(found,error)
    if (error) return
  end subroutine cubeedit_opened_list_close
  !
  subroutine cubeedit_opened_list_list(list,error)
    !----------------------------------------------------------------------
    ! List the currently open buffers
    !----------------------------------------------------------------------
    class(opened_list_t), intent(in)    :: list
    logical,              intent(inout) :: error
    !
    character(len=mess_l) :: mess,bmess
    integer(kind=list_k) :: ibuff
    type(opened_object_t), pointer :: buffer
    character(len=*), parameter :: rname='OPENED>LIST>LIST'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    write(mess,'(a,i0)') 'Currently Opened cubes for edition: ',list%n
    call cubeedit_message(seve%r,rname,mess)
    if (list%n.gt.0) then
       write(mess,'(3x,a,x,a,24x,a,4x,a,x,a)') '#','Editing Id','Access','Orig Id','Entry'
       call cubeedit_message(seve%r,rname,mess)
       !
       do ibuff=1, list%n
          buffer => list%get_ptr(ibuff,error)
          if (error) return
          call buffer%list(bmess,error)
          if (error) return
          write(mess,'(i4)') ibuff
          mess = trim(mess)//' '//bmess
          call cubeedit_message(seve%r,rname,mess)
       enddo
    endif
  end subroutine cubeedit_opened_list_list
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeedit_opened_list_get_editedid(list,inid,ouid,error)
    !----------------------------------------------------------------------
    ! Return the editedid if the cube is found in the opened list
    !----------------------------------------------------------------------
    class(opened_list_t),  intent(in)    :: list
    character(len=*),      intent(in)    :: inid
    character(len=*),      intent(out)   :: ouid
    logical,               intent(inout) :: error
    !
    type(opened_object_t), pointer :: buffer
    character(len=*), parameter :: rname='OPENED>LIST>GET>EDITEDID'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    buffer => list%get_ptr(inid,error)
    if (error) return
    ouid = buffer%editedid
  end subroutine cubeedit_opened_list_get_editedid
  !
  subroutine cubeedit_opened_list_get_cube_pointer(list,idname,cube,error)
    !----------------------------------------------------------------------
    ! Return a pointer to the buffer cube if the cube is found in the opened list
    !----------------------------------------------------------------------
    class(opened_list_t),  intent(in)    :: list
    character(len=*),      intent(in)    :: idname
    type(cube_t), pointer, intent(out)   :: cube
    logical,               intent(inout) :: error
    !
    type(opened_object_t), pointer :: buffer
    character(len=*), parameter :: rname='OPENED>LIST>GET>CUBE>POINTER'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    buffer => list%get_ptr(idname,error)
    if (error) return
    cube => buffer%cube
  end subroutine cubeedit_opened_list_get_cube_pointer
  !
  subroutine cubeedit_opened_list_get_cube_entry(list,idname,ie,error)
    !----------------------------------------------------------------------
    ! Return the last touched entry for idname
    !----------------------------------------------------------------------
    class(opened_list_t),  intent(in)    :: list
    character(len=*),      intent(in)    :: idname
    integer(kind=entr_k),  intent(out)   :: ie
    logical,               intent(inout) :: error
    !
    type(opened_object_t), pointer :: buffer
    character(len=*), parameter :: rname='OPENED>LIST>GET>CUBE>ENTRY'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    buffer => list%get_ptr(idname,error)
    if (error) return
    ie = buffer%ie
  end subroutine cubeedit_opened_list_get_cube_entry
  !
  subroutine cubeedit_opened_list_set_cube_entry(list,idname,ie,error)
    !----------------------------------------------------------------------
    ! Set the last touched entry for idname
    !----------------------------------------------------------------------
    class(opened_list_t),  intent(in)    :: list
    character(len=*),      intent(in)    :: idname
    integer(kind=entr_k),  intent(in)    :: ie
    logical,               intent(inout) :: error
    !
    type(opened_object_t), pointer :: buffer
    character(len=*), parameter :: rname='OPENED>LIST>SET>CUBE>ENTRY'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    buffer => list%get_ptr(idname,error)
    if (error) return
    buffer%ie = ie
  end subroutine cubeedit_opened_list_set_cube_entry
  !
  function cubeedit_opened_object_ptr_byname(list,idname,error) result(ptr)
    !-------------------------------------------------------------------
    ! Given its name, return a pointer to the named buffer currently
    ! opened.
    !-------------------------------------------------------------------
    class(opened_list_t),  intent(in)    :: list
    type(opened_object_t), pointer       :: ptr
    character(len=*),      intent(in)    :: idname
    logical,               intent(inout) :: error
    !
    integer(kind=list_k) :: found
    character(len=*), parameter :: rname='CUBE>BUFFER>PTR'
    !
    ptr => null()
    !
    call list%find(idname,found,error)
    if (error) return
    if (found.eq.not_found) then
       call cubeedit_message(seve%e,rname,trim(idname)//' is not currently opened')
       error = .true.
       return
    endif
    !
    ptr => list%get_ptr_bynum(found,error)
    if (error) return
  end function cubeedit_opened_object_ptr_byname
  !
  function cubeedit_opened_object_ptr_bynum(list,ibuffer,error) result(ptr)
    !-------------------------------------------------------------------
    ! Given its number, return a pointer to the named buffer currently
    ! opened.
    !-------------------------------------------------------------------
    class(opened_list_t),  intent(in)    :: list
    type(opened_object_t), pointer       :: ptr
    integer(kind=list_k),  intent(in)    :: ibuffer
    logical,               intent(inout) :: error
    !
    class(list_object_t), pointer :: object
    character(len=*), parameter :: rname='CUBE>BUFFER>PTR'
    !
    ptr => null()
    !
    if (ibuffer.le.0 .or. ibuffer.gt.ubound(list%list,1)) then
      call cubeedit_message(seve%e,rname,'Internal error: invalid buffer number')
      error = .true.
      return
    endif
    !
    object => list%list(ibuffer)%p
    select type (object)
    type is (opened_object_t)
       ptr => object
    class default
       call cubeedit_message(seve%e,rname,'Internal error: object has wrong type')
       error = .true.
       return
    end select
  end function cubeedit_opened_object_ptr_bynum
end module cubeedit_opened_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
