!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeedit_getdata
  use cubetools_parameters
  use cubelist_types
  use cubetools_structure
  use cubetools_keywordlist_types
  use cubetools_userspace
  use cubetools_uservar
  use cube_types
  use cubetopology_spapos_types
  use cubetopology_spechannel_types
  use cubeedit_cube_types
  use cubeedit_entry
  use cubeedit_which_data
  use cubeedit_messaging
  !  
  public :: getdata_comm_t,getdata_user_t
  public :: access_is_fixed,access_not_fixed,entr_unk
  private
  !
  integer(kind=4), parameter :: izero=1
  integer(kind=4), parameter :: ifirst=2
  integer(kind=4), parameter :: ilast=3
  integer(kind=4), parameter :: inext=4
  integer(kind=4), parameter :: iprevious=5
  integer(kind=4), parameter :: iafter=6
  integer(kind=4), parameter :: icurrent=7
  integer(kind=4), parameter :: nwhich = icurrent
  !
  character(len=*), parameter :: options(nwhich) = &
       ['ZERO     ','FIRST    ','LAST     ','NEXT     ','PREVIOUS ','AFTERLAST','CURRENT  ']
  !
  logical, parameter :: access_is_fixed  = .true.
  logical, parameter :: access_not_fixed = .false.
  logical, parameter :: active = .true.
  integer(kind=entr_k), parameter :: entr_unk = -1000
  !
  type :: getdata_comm_t
     type(which_comm_t)             :: which(1:nwhich)
     type(entry_opt_t)              :: entry
     type(spapos_comm_t)            :: pixel    
     type(spechannel_opt_t)         :: channel
     type(cube_opt_t)               :: cube
     type(userspace_opt_t), pointer :: into
     logical                        :: fixed
   contains
     procedure :: register => cubeedit_getdata_register
     procedure :: parse    => cubeedit_getdata_parse_and_check
     procedure :: get      => cubeedit_getdata_command
     procedure :: list     => cubeedit_getdata_list_buffers
  end type getdata_comm_t
  !
  type getdata_user_t
     type(userspace_user_t), pointer :: uservar
     type(which_user_t)              :: which(1:nwhich)
     type(entry_user_t)              :: entry
     type(spapos_user_t)             :: pixel
     type(spechannel_user_t)         :: channel
     type(cube_user_t)               :: cube
     logical                         :: show
     logical                         :: do
  end type getdata_user_t
  !
  type getdata_prog_t
     type(cube_t), pointer          :: cube
     integer(kind=entr_k)           :: ie
     integer(kind=4)                :: ibuffer
     integer(kind=code_k), private  :: doaccess
     logical                        :: get
     type(uservar_t)                :: uservar
  end type getdata_prog_t
  !
  integer(kind=code_k), parameter :: code_not_used = -1
  integer(kind=code_k), parameter :: code_defined  = 2
  !
  type, extends(userspace_t) :: getdata_buffer_t
     integer(kind=4)      :: id
     integer(kind=entr_k) :: ie   = 0
     integer(kind=code_k) :: status = code_not_used
  end type getdata_buffer_t
  !
  type(list_t) :: imaglist,speclist,cubelist
  !
contains
  !
  subroutine cubeedit_getdata_register(comm,into,fixed,iterator,error)
    !-------------------------------------------------------------------
    ! Register for EDIT\GET and  GO\LOAD (data part)
    !-------------------------------------------------------------------
    class(getdata_comm_t), intent(out)   :: comm
    type(userspace_opt_t), target        :: into
    logical,               intent(in)    :: fixed
    logical,               intent(in)    :: iterator
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: iwhich
    logical :: listactive(nwhich)
    character(len=*), parameter :: rname='GETDATA>REGISTER'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    comm%into  => into
    comm%fixed =  fixed
    if (iterator) then
       listactive(:) = active
    else
       listactive(:) = .not.active
       listactive(ifirst)     = active
       listactive(ilast)      = active
    endif
    !
    do iwhich=1, nwhich
       call comm%which(iwhich)%register(options(iwhich), &
            'Get the '//trim(options(iwhich))//' entry from the cube',&
            fixed,listactive(iwhich),error)
       if (error) return
    enddo
    !
    ! /ENTRY
    call comm%entry%register(&
         'Get the i-th entry from the cube',fixed,error)
    if (error) return
    !
    ! /PIXEL
    call comm%pixel%register("PIXEL",&
         'Define the position of the pixel to be gotten',&
         error)
    if (error) return
    !
    ! /CHANNEL
    call comm%channel%register('CHANNEL',&
         'Get a channel from the cube',&
         error)
    if (error) return
    !
    ! /CUBE
    call comm%cube%register('CUBE',&
         'Get the full cube',&
         error)
    if (error) return
  end subroutine cubeedit_getdata_register
  !
  subroutine cubeedit_getdata_parse_and_check(comm,line,userspace,user,error)
    !-------------------------------------------------------------------
    ! Parse for the data options, and return flag indicating if
    ! something relevant here is to be done
    !-------------------------------------------------------------------
    class(getdata_comm_t),  intent(in)    :: comm
    character(len=*),       intent(in)    :: line
    type(userspace_user_t), target        :: userspace
    type(getdata_user_t),   intent(out)   :: user
    logical,                intent(inout) :: error
    !
    call cubetools_userspace_array_update(imaglist,error)
    if (error) return
    call cubetools_userspace_array_update(speclist,error)
    if (error) return
    call cubetools_userspace_array_update(cubelist,error)
    if (error) return
    call cubeedit_getdata_parse(comm,line,user,error)
    if (error) return
    user%do = .not.user%show
    user%uservar => userspace
  end subroutine cubeedit_getdata_parse_and_check
  !
  subroutine cubeedit_getdata_parse(comm,line,user,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(getdata_comm_t),  intent(in)    :: comm
    character(len=*),       intent(in)    :: line
    type(getdata_user_t),   intent(out)   :: user
    logical,                intent(inout) :: error
    !
    integer(kind=4) :: nopt,iwhich
    character(len=*), parameter :: rname='GETDATA>PARSE'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    nopt = 0
    do iwhich=1, nwhich
       call comm%which(iwhich)%parse(line,user%which(iwhich),error)
       if (error) return
       if (user%which(iwhich)%do) nopt = nopt+1 
    enddo
    ! /ENTRY
    call comm%entry%parse(line,user%entry,error)
    if (error) return
    if (user%entry%do) nopt = nopt+1 
    ! /PIXEL
    call comm%pixel%parse(line,user%pixel,error)
    if (error) return
    if (user%pixel%present) nopt = nopt+1 
    ! /CHANNEL
    call comm%channel%parse(line,user%channel,error)
    if (error) return
    if (user%channel%do) nopt = nopt+1
    ! /CUBE
    call comm%cube%parse(line,user%cube,error)
    if (error) return
    if (user%cube%do) nopt = nopt+1 
    !
    if (nopt.eq.0) then
       user%show = .true.
       return
    else if (nopt.ge.2) then
       call cubeedit_message(seve%e,rname,'Data related options are mutually exclusive')
       error = .true.
       return
    else
      user%show = .false.
    endif
  end subroutine cubeedit_getdata_parse
  !
  subroutine cubeedit_getdata_command(comm,user,cube,defname,dohead,ie,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(getdata_comm_t),  intent(in)    :: comm
    type(getdata_user_t),   intent(in)    :: user
    type(cube_t),target,    intent(in)    :: cube
    character(len=*),       intent(in)    :: defname
    logical,                intent(in)    :: dohead
    integer(kind=entr_k),   intent(inout) :: ie
    logical,                intent(inout) :: error
    !
    type(getdata_prog_t) :: prog
    character(len=*), parameter :: rname='GETDATA>COMMAND'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    prog%cube => cube
    call cubeedit_getdata_user2prog(comm,user,defname,dohead,ie,prog,error)
    if (error) return
    call cubeedit_getdata_act(prog,error)
    if (error) return
  end subroutine cubeedit_getdata_command
  !
  subroutine cubeedit_getdata_user2prog(comm,user,defname,dohead,ie,prog,error)
    use cubeadm_get
    use cubetools_userstruct
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(getdata_comm_t),  intent(in)    :: comm
    type(getdata_user_t),   intent(in)    :: user
    character(len=*),       intent(in)    :: defname
    logical,                intent(in)    :: dohead
    integer(kind=entr_k),   intent(inout) :: ie
    type(getdata_prog_t),   intent(inout) :: prog
    logical,                intent(inout) :: error
    !
    integer(kind=4) :: iwhich
    character(len=varn_l) :: varname
    type(spapos_prog_t) :: pixel
    type(spechannel_prog_t) :: channel
    type(userstruct_t) :: parent
    logical, parameter :: local=.false., overwrite = .true.
    character(len=*), parameter :: rname='GETDATA>USER2PROG'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    ! 1) Guess the access mode
    if (comm%fixed) then
       prog%doaccess = prog%cube%order()
       if (user%pixel%present .and. prog%doaccess.eq.code_access_imaset) then
          call cubeedit_message(seve%e,rname,'Cannot get a pixel from a cube that is accessed by images')
          error = .true.
          return
       endif
       if (user%channel%do .and. prog%doaccess.eq.code_access_speset) then
          call cubeedit_message(seve%e,rname,'Cannot get a channel from a cube that is accessed by spectra')
          error = .true.
          return
       endif
    else
       if (user%entry%do) then
          call comm%entry%user2prog(user%entry,prog%doaccess,error)
          if (error) return
       else if (user%channel%do) then
          prog%doaccess = code_access_imaset
       else if (user%pixel%present) then
          prog%doaccess = code_access_speset
       else if (user%cube%do) then
          prog%doaccess = code_access_fullset
       else
          do iwhich=1,nwhich
             if (.not.user%which(iwhich)%do)  cycle
             call comm%which(iwhich)%user2prog(user%which(iwhich),prog%doaccess,error)
             if (error) return
          enddo
       endif
    endif
    !
    ! 2) Re-access cube with the proper access. Do not insert it in the parents list,
    !    otherwise this would "finish" the cube buffer which is currently opened (by
    !    OPEN).
    call cubeadm_access_header(prog%cube,prog%doaccess,code_read,error,opened=.false.)
    if (error) return
    !
    ! 3) Get/Set the output variable
    select case (prog%doaccess)
    case (code_access_imaset)
       varname = 'image'
    case (code_access_speset)
       varname = 'spectrum'
    case (code_access_fullset)
       varname = 'cube'
    end select
    if (dohead) then ! If also doing header, always a sub structure
       if (user%uservar%do) then
          call cubetools_userspace_get(user%uservar%name,parent,error)
          if (error) return
       else
          call cubetools_userspace_get(defname,parent,error)
          if (error) return
       endif
       call parent%create_member(varname,prog%uservar,error)
       if (error) return
    else
       if (user%uservar%do) then
          call comm%into%user2prog(user%uservar,prog%uservar,error)
          if (error) return
       else
          call parent%create(defname,local,overwrite_user,error)
          if (error) return
          call parent%create_member(varname,prog%uservar,error)
          if (error) return
       endif
    endif
    !
    ! 4) Get a/the buffer associated to the cube
    call cubeedit_getdata_buffer(prog,error)
    if (error) return
    !
    ! 5) Compute which entry is to be fetched
    if (user%entry%do) then
       prog%ie = user%entry%ientry
    else if (user%channel%do) then
       call user%channel%toprog(comm%channel,prog%cube,channel,error)
       if (error) return
       prog%ie = channel%ic
    else if (user%pixel%present) then
       call user%pixel%toprog(prog%cube,pixel,error)
       if (error) return
       prog%ie = pixel%nearest_entry()
    else if (user%cube%do) then
       prog%ie = 1
    else
       do iwhich=1,nwhich
          if (.not.user%which(iwhich)%do)  cycle
          select case (iwhich)
          case (izero)
             prog%ie = 0
          case (ifirst)
             prog%ie = 1
          case (ilast)
             prog%ie = prog%cube%nentry()
          case (inext)
             if (ie.eq.entr_unk) then
                prog%ie = prog%ie+1
             else
                prog%ie = ie+1
             endif
          case (iprevious)
             if (ie.eq.entr_unk) then
                prog%ie = prog%ie-1
             else
                prog%ie = ie-1
             endif
          case (iafter)
             prog%ie = prog%cube%nentry()+1
          case (icurrent)
             if (ie.eq.entr_unk) then
                prog%ie = prog%ie
             else
                prog%ie = ie
             endif
          end select
       enddo
    endif
    !
    if (prog%ie.lt.1 .or. prog%ie.gt.prog%cube%nentry()) then
      ! Not an error: we might want to iterate beyond limits, and
      ! return empty data. Should we raise a warning or not is unclear.
      ! write(mess,'(3(A,I0))')  'Trying to fetch entry #',prog%ie,  &
      !  ' while entry range is ',1,'-',prog%cube%nentry()
      ! call cubeedit_message(seve%w,rname,mess)
      prog%get = .false.
    else
      prog%get = .true.
    endif
    ie = prog%ie
  end subroutine cubeedit_getdata_user2prog
  !
  subroutine cubeedit_getdata_act(prog,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(getdata_prog_t), intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='GETDATA>ACT'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    select case (prog%doaccess)
    case (code_access_imaset)
       if (prog%cube%iscplx()) then
          call cubeedit_getdata_act_image_cplx(prog,error)
          if (error) return
       else
          call cubeedit_getdata_act_image_real(prog,error)
          if (error) return
       endif
    case (code_access_speset)
       if (prog%cube%iscplx()) then
          call cubeedit_message(seve%e,rname,'Getting complex spectra is unsupported')
          error = .true.
          return
!!$          call cubeedit_getdata_act_spectrum_cplx(prog,error)
!!$          if (error) return
       else
          call cubeedit_getdata_act_spectrum_real(prog,error)
          if (error) return
       endif
    case (code_access_fullset)
       if (prog%cube%iscplx()) then
          call cubeedit_message(seve%e,rname,'Getting complex cubes is not implemented')
          error = .true.
          return
       else
          call cubeedit_getdata_act_cube_real(prog,error)
          if (error) return
       endif
    end select
  end subroutine cubeedit_getdata_act
  !
  subroutine cubeedit_getdata_act_image_real(prog,error)
    use cubetools_nan
    use cubeadm_ioloop
    use cubeadm_image_types
    use cubeadm_taskloop
    use cubeset_plot_tool
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(getdata_prog_t), intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    type(image_t) :: locima
    type(getdata_buffer_t), pointer :: buffer
    character(len=*), parameter :: rname='GETDATA>ACT>IMAGE>REAL'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    if (prog%get) then
       call locima%associate('real locima',prog%cube,error)
       if (error) return
       call cubeadm_io_iterate(prog%ie,prog%ie,prog%cube,error)
       if (error) return
       call locima%get(prog%ie,error)
       if (error) return
    else
       call locima%allocate('real locima',prog%cube,error)
       if (error) return
       call locima%set(gr4nan,error)
       if (error) return
    endif
    call plot%put_image_into_rg(prog%cube%head,locima%val,error)
    if (error) return
    call prog%uservar%set(locima%val,error)
    if (error) return
    !
    buffer => getdata_buffer_ptr(imaglist%list(prog%ibuffer)%p,error)
    if (error)  return
    buffer%ie          = prog%ie
    buffer%status      = code_defined
    buffer%id          = prog%cube%node%id
    buffer%userspace_t = prog%uservar%userspace_t
  end subroutine cubeedit_getdata_act_image_real
  !
  subroutine cubeedit_getdata_act_image_cplx(prog,error)
    use gkernel_interfaces
    use cubetools_nan
    use cubeadm_ioloop
    use cubeadm_visi_types
    use cubeadm_taskloop
    use cubeset_plot_tool
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(getdata_prog_t), intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    type(visi_t) :: locima
    integer(kind=4) :: ier
    real(kind=sign_k),allocatable :: modulus(:,:)
    type(getdata_buffer_t), pointer :: buffer
    character(len=*), parameter :: rname='GETDATA>ACT>IMAGE>CPLX'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    if (prog%get) then
       call locima%associate('cplx locima',prog%cube,error)
       if (error) return
       call cubeadm_io_iterate(prog%ie,prog%ie,prog%cube,error)
       if (error) return
       call locima%get(prog%ie,error)
       if (error) return
    else
       call locima%allocate('cplx locima',prog%cube,error)
       if (error) return
       call locima%set(gc4nan,error)
       if (error) return
    endif
    allocate(modulus(locima%nx,locima%ny),stat=ier)
    if (failed_allocate(rname,'modulus',ier,error)) return
    modulus(:,:) = sqrt(real(locima%val(:,:))**2+aimag(locima%val(:,:))**2)
    call plot%put_image_into_rg(prog%cube%head,modulus,error)
    if (error) return
    call prog%uservar%set(locima%val,error)
    if (error) return
    !
    buffer => getdata_buffer_ptr(imaglist%list(prog%ibuffer)%p,error)
    if (error)  return
    buffer%ie          = prog%ie
    buffer%status      = code_defined
    buffer%id          = prog%cube%node%id
    buffer%userspace_t = prog%uservar%userspace_t
  end subroutine cubeedit_getdata_act_image_cplx
  !
  subroutine cubeedit_getdata_act_spectrum_real(prog,error)
    use cubetools_nan
    use cubeadm_ioloop
    use cubeadm_taskloop
    use cubeadm_spectrum_types
    use cubeset_plot_tool
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(getdata_prog_t), intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    type(spectrum_t) :: spe
    type(getdata_buffer_t), pointer :: buffer
    character(len=*), parameter :: rname='GETDATA>ACT>SPECTRUM>REAL'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    if (prog%get) then
       call spe%associate('spe',prog%cube,error)
       if (error) return
       call cubeadm_io_iterate(prog%ie,prog%ie,prog%cube,error)
       if (error) return
       call spe%get(prog%ie,error)
       if (error) return
    else
       call spe%allocate('spe',prog%cube,error)
       if (error) return
       call spe%y%set(gr4nan,error)
       if (error) return
    endif
    call plot%put_spectrum_into_xy(prog%cube%head,spe%y%val,error)
    if (error) return
    call prog%uservar%set(spe%y%val,error)
    if (error) return
    !
    buffer => getdata_buffer_ptr(speclist%list(prog%ibuffer)%p,error)
    if (error)  return
    buffer%ie          = prog%ie
    buffer%status      = code_defined
    buffer%id          = prog%cube%node%id
    buffer%userspace_t = prog%uservar%userspace_t
  end subroutine cubeedit_getdata_act_spectrum_real
  !
!!$  subroutine cubeedit_getdata_act_spectrum_cplx(prog,error)
!!$    use gkernel_interfaces
!!$    use cubeadm_ioloop
!!$    use cubemain_spectrum_cplx
!!$    !------------------------------------------------------------------------
!!$    !
!!$    !------------------------------------------------------------------------
!!$    type(getdata_prog_t), intent(inout) :: prog
!!$    logical,              intent(inout) :: error
!!$    !
!!$    type(spectrum_cplx_t) :: locspe
!!$    integer(kind=4) :: ier
!!$    real(kind=4), allocatable :: modulus(:)
!!$    type(getdata_buffer_t), pointer :: buffer
!!$    character(len=*), parameter :: rname='GETDATA>ACT>SPECTRUM>CPLX'
!!$    !
!!$    call cubeedit_message(edseve%trace,rname,'Welcome')
!!$    !
!!$    if (prog%get) then
!!$       call locspe%reassociate_and_init(prog%cube,error)
!!$       if (error) return
!!$       call cubeadm_io_iterate(prog%ie,prog%ie,prog%cube,error)
!!$       if (error) return
!!$       call locspe%get(prog%cube,prog%ie,error)
!!$       if (error) return
!!$    else
!!$       call locspe%reallocate_and_init(prog%cube,error)
!!$       if (error) return
!!$    endif
!!$    allocate(modulus(locspe%m),stat=ier)
!!$    if (failed_allocate(rname,'modulus',ier,error)) return
!!$    modulus(:) = sqrt(real(locspe%t(:))**2+aimag(locspe%t(:))**2)
!!$    call plot%put_spectrum_into_xy(prog%cube%head,modulus,error)
!!$    if (error) return
!!$    call prog%uservar%set(locspe%t,error)
!!$    if (error) return
!!$    !
!!$    buffer => getdata_buffer_ptr(speclist%list(prog%ibuffer)%p,error)
!!$    if (error)  return
!!$    buffer%ie          = prog%ie
!!$    buffer%status      = code_defined
!!$    buffer%id          = prog%cube%node%id
!!$    buffer%userspace_t = prog%uservar%userspace_t
!!$  end subroutine cubeedit_getdata_act_spectrum_cplx
  !
  subroutine cubeedit_getdata_act_cube_real(prog,error)
    use cubeadm_opened
    use cubeadm_subcube_types
    use cubeadm_image_types
    use cubeset_plot_tool
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(getdata_prog_t), intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    type(subcube_t) :: subcube
    type(cubeadm_iterator_t) :: iter
    logical :: ier
    type(getdata_buffer_t), pointer :: buffer
    character(len=*), parameter :: rname='GETDATA>ACT>CUBE>REAL'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    if (prog%get) then
       ! Prepare an iterator to iterate everything at once, as prog%cube was opened
       ! with code_access_fullset. Note that this mode enforces the load of the
       ! full cube in memory, independently of the SET\BUFFERING /INPUT mode.
       call cubeadm_datainit_all(iter,error)
       if (error)  return
       ! This should have set up a unique iteration, and a unique subcube entry
       ! in this iteration.
       ! Iterate the iterator to its unique iteration (in particular, ensure that
       ! the whole cube is loaded in memory).
       ier = cubeadm_dataiterate_all(iter,error)
       if (error)  return
       ! Iterate the unique subcube entry in this unique iteration, so that we
       ! can get it hereafter.
       ier = iter%iterate_entry(error)
       if (error)  return
       ! The subcube is prepared to point to the full cube (associate mode).
       ! This avoids duplicating the data, and this is possible because of
       ! the forced memory mode above.
       call subcube%associate('real subcube',prog%cube,iter,error)
       if (error) return
       call subcube%get(error)
       if (error) return
       ! Also load the 1st plane into the RG buffer (for at least the
       ! WCS description).
       if (prog%cube%order().eq.code_cube_imaset) then
         ! This only makes sense if the cube is image-ordered
         call plot%put_image_into_rg(prog%cube%head,subcube%val(:,:,1),error)
         if (error) return
       endif
    else
       call cubeedit_message(seve%e,rname,'Not implemented')
       error = .true.
       return
    endif
    ! Create the /INTO variable. Note that this duplicates the data, on purpose,
    ! as the original data can be destroyed at any time (in this case, the full
    ! cube might be destroyed or garbage-collected from memory).
    call prog%uservar%set(subcube%val,error)
    if (error) return
    !
    buffer => getdata_buffer_ptr(cubelist%list(prog%ibuffer)%p,error)
    if (error)  return
    buffer%ie          = 0  ! No sense for full cubes
    buffer%status      = code_defined
    buffer%id          = prog%cube%node%id
    buffer%userspace_t = prog%uservar%userspace_t
  end subroutine cubeedit_getdata_act_cube_real
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeedit_getdata_list_buffers(comm,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(getdata_comm_t), intent(in)    :: comm
    logical,               intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='GETDATA>LIST>BUFFERS'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    write(mess,'(a,i0)') 'Loaded Image buffers: ',imaglist%n
    call cubeedit_message(seve%r,rname,mess)
    call cubeedit_getdata_list_buffer(imaglist)
    !
    write(mess,'(a,i0)') 'Loaded Spectrum buffers: ',speclist%n
    call cubeedit_message(seve%r,rname,mess)
    call cubeedit_getdata_list_buffer(speclist)
    !
    write(mess,'(a,i0)') 'Loaded Cube buffers: ',cubelist%n
    call cubeedit_message(seve%r,rname,mess)
    call cubeedit_getdata_list_buffer(cubelist)
  end subroutine cubeedit_getdata_list_buffers
  !
  subroutine cubeedit_getdata_list_buffer(arr)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(list_t), intent(in) :: arr
    !
    integer(kind=4) :: ibuffer
    class(list_object_t), pointer :: buffer
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='GETDATA>LIST>BUFFER'
    !
    do ibuffer=1,arr%n
      buffer => arr%list(ibuffer)%p
      select type (buffer)
      type is (getdata_buffer_t)
        write(mess,1001) ibuffer,' => CUBE id: ',buffer%id,  &
            ', entry: ',buffer%ie, &
            ', SIC variable: ',trim(buffer%name)
      class is (userspace_t)
        write(mess,1002) ibuffer,' => CUBE id: ','TBD',  &
            ', entry: ','TBD', &
            ', SIC variable: ',trim(buffer%name)
      class default
        write(mess,1002) ibuffer,' => CUBE id: ','TBD',  &
            ', entry: ','TBD', &
            ', SIC variable: ','TBD'
      end select
      call cubeedit_message(seve%r,rname,mess)
    enddo
    call cubeedit_message(seve%r,rname,'')
    !
1001 format(2x,i2,a,i4,a,i7,2a)
1002 format(2x,i2,a,a4,a,a7,2a)
  end subroutine cubeedit_getdata_list_buffer
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeedit_getdata_buffer(prog,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(getdata_prog_t), intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    select case (prog%doaccess)
    case (code_access_imaset)
      call cubeedit_getdata_buffer_from(prog,imaglist,error)
      if (error) return
    case (code_access_speset)
      call cubeedit_getdata_buffer_from(prog,speclist,error)
      if (error) return
    case (code_access_fullset)
      call cubeedit_getdata_buffer_from(prog,cubelist,error)
      if (error) return
    end select
  end subroutine cubeedit_getdata_buffer
  !
  subroutine cubeedit_getdata_buffer_from(prog,array,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(getdata_prog_t), intent(inout) :: prog
    type(list_t),         intent(inout) :: array
    logical,              intent(inout) :: error
    !
    type(getdata_buffer_t), pointer :: buffer
    type(getdata_buffer_t) :: template
    class(list_object_t), pointer :: lot
    logical :: samevar, samecube
    integer(kind=list_k) :: ibuffer
    character(len=*), parameter :: rname='GETDATA>BUFFER>FROM'
    !
    ! Find if refering to a previously defined buffer
    do ibuffer=1,array%n
      buffer => getdata_buffer_ptr(array%list(ibuffer)%p,error)
      if (error)  return
      samecube = prog%cube%node%id.eq.buffer%id
      samevar  = prog%uservar%name.eq.buffer%name
      if (samecube.and.samevar) then
        prog%ibuffer = ibuffer
        prog%ie      = buffer%ie
        return
      endif
    enddo
    !
    ! No previous buffer found, insert new one
    call array%allocate(template,lot,error)
    if (error)  return
    buffer => getdata_buffer_ptr(lot,error)
    if (error)  return
    buffer%ie = 0  ! GET NEXT gets FIRST
    ! buffer%... => other elements updated later
    ! Save instance in prog structure
    prog%ibuffer = array%n
    prog%ie      = 0
  end subroutine cubeedit_getdata_buffer_from
  !
  function getdata_buffer_ptr(buffer,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of type(getdata_buffer_t), and return
    ! a pointer to it if yes.
    !-------------------------------------------------------------------
    type(getdata_buffer_t), pointer :: getdata_buffer_ptr  ! Function value on return
    class(list_object_t),   pointer       :: buffer
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='GETDATA>BUFFER>PTR'
    !
    select type(buffer)
    type is (getdata_buffer_t)
      getdata_buffer_ptr => buffer
    class default
      getdata_buffer_ptr => null()
      call cubeedit_message(seve%e,rname,  &
        'Internal error: object is not a getdata_buffer_t type')
      error = .true.
      return
    end select
  end function getdata_buffer_ptr
end module cubeedit_getdata
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
