!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeedit_putdata
  use cubetools_structure
  use cubemain_spapos_types
  use cubemain_spechannel_types
  use cubeedit_messaging
  use cubeedit_entry
  use cubeedit_which_data
  !
  public :: putdata_comm_t,putdata_user_t
  !
  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.
  !
  type :: putdata_comm_t
     type(entry_opt_t)       :: entry
     type(spapos_opt_t)      :: pixel
     type(spechannel_opt_t)  :: channel
     type(which_comm_t)      :: which(1:nwhich)
     type(option_t), pointer :: from
   contains
     procedure, public :: register => cubeedit_putdata_register
     procedure, public :: parse    => cubeedit_putdata_parse
     procedure, public :: main     => cubeedit_putdata_main
  end type putdata_comm_t
  !
  type putdata_user_t
     type(which_user_t)      :: which(1:nwhich)
     type(entry_user_t)      :: entry     
     type(spapos_user_t)     :: pixel
     type(spechannel_user_t) :: channel
     logical                 :: dofrom
     character(len=varn_l)   :: varname
     logical                 :: do
  end type putdata_user_t
  !
contains
  !
  subroutine cubeedit_putdata_register(putdata,error)
    !----------------------------------------------------------------------
    ! Register options related to data edition
    !----------------------------------------------------------------------
    class(putdata_comm_t), intent(inout) :: putdata
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: iwhich
    type(standard_arg_t) :: stdarg
    logical, parameter :: access_is_fixed = .true.
    logical, parameter :: active = .true.
    character(len=*), parameter :: rname='PUT>DATA>REGISTER'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    do iwhich=1, nwhich
       call putdata%which(iwhich)%register(options(iwhich), &
            'Put the '//trim(options(iwhich))//' entry into the cube',&
            access_is_fixed,active,error)
       if (error)  return
    enddo
    !
    call putdata%entry%register(&
         'Define the entry to be put in the cube',access_is_fixed,error)
    if (error) return
    ! 
    call putdata%pixel%register('PIXEL',&
         'Define the position of the pixel to be put',&
         error)
    if (error) return
    !
    call putdata%channel%register('CHANNEL',&
         'Define the velocity of the channel to be put',&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'FROM','varname',&
         'Define from which variable we fetch data',&
         strg_id,&
         putdata%from,error)
    if (error) return
    call stdarg%register(&
         'varname',&
         'Variable name containing data to be put',&
         strg_id,&
         code_arg_mandatory,error)
    if (error) return
  end subroutine cubeedit_putdata_register
  !
  subroutine cubeedit_putdata_parse(putdata,line,user,error)
    !-------------------------------------------------------------------
    ! Parse routine for data part of command PUT
    !-------------------------------------------------------------------
    class(putdata_comm_t), intent(in)    :: putdata
    character(len=*),      intent(in)    :: line
    type(putdata_user_t),  intent(out)   :: user
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: nopt,iwhich
    character(len=mess_l) :: optmess
    character(len=*), parameter :: rname='PUT>DATA>PARSE'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    nopt = 0
    do iwhich=1, nwhich
       call putdata%which(iwhich)%parse(line,user%which(iwhich),error)
       if (error)  return
       if (user%which(iwhich)%do) nopt = nopt+1 
    enddo
    ! /ENTRY
    call putdata%entry%parse(line,user%entry,error)
    if (error) return
    if (user%entry%do)   nopt = nopt+1
    ! /PIXEL
    call putdata%pixel%parse(line,user%pixel,error)
    if (error) return
    if (user%pixel%do)   nopt = nopt+1
    ! /CHANNEL
    call putdata%channel%parse(line,user%channel,error)
    if (error) return
    if (user%channel%do) nopt = nopt+1
    !
    ! FROM
    call putdata%from%present(line,user%dofrom,error)
    if (error) return
    !
    optmess = 'Options'
    do iwhich=1,nwhich
       optmess = trim(optmess)//' /'//trim(options(iwhich))//','
    enddo
    optmess = trim(optmess)//' /ENTRY, /CHANNEL and /PIXEL'
    
    user%do = .false.
    if (nopt.eq.1) then
       if (user%dofrom) then
          call cubetools_getarg(line,putdata%from,1,user%varname,mandatory,error)
          if (error) return
          user%do = .true.
       else
          call cubeedit_message(seve%e,rname,trim(optmess)//' Require option /FROM')
          error = .true.
          return
       endif
    else if (nopt.gt.1) then ! Problem, Conflicting options
       call cubeedit_message(seve%e,rname,trim(optmess)//' conflict with each other')
       error = .true.
       return
    else ! Nothing to be done
       if (user%dofrom) call cubeedit_message(seve%w,rname,'Option &
            &/FROM only applies to '//trim(optmess))
    endif
  end subroutine cubeedit_putdata_parse
  !
  subroutine cubeedit_putdata_main(putdata,user,cube,ie,error)
    use cube_types
    use cubeadm_get
    !-------------------------------------------------------------------
    ! Main routine for data part of command PUT
    !-------------------------------------------------------------------
    class(putdata_comm_t), intent(in)    :: putdata
    type(putdata_user_t),  intent(in)    :: user
    type(cube_t), pointer, intent(inout) :: cube
    integer(kind=entr_k),  intent(inout) :: ie
    logical,               intent(inout) :: error
    !
    logical :: doimg,put
    integer(kind=4) :: iwhich
    type(spapos_prog_t) :: pixel
    type(spechannel_prog_t) :: channel
    character(len=*), parameter :: rname='PUT>DATA>MAIN'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    if (user%do) then
       doimg = cube%order().eq.code_access_imaset
       if (user%pixel%do.and.doimg) then
          call cubeedit_message(seve%e,rname,'Cannot put a pixel in a cube that is accessed by images')
          error = .true.
          return
       endif
       if (user%channel%do.and..not.doimg) then
          call cubeedit_message(seve%e,rname,'Cannot put a channel in a cube that is accessed by spectra')
          error = .true.
          return
       endif
       !
       put = .true.
       if (user%pixel%do) then
          call user%pixel%toprog(cube,pixel,error)
          if (error) return
          ie = pixel%ie
       else if (user%channel%do) then
          call user%channel%toprog(putdata%channel,cube,channel,error)
          if (error) return
          ie = channel%ic
       else if (user%entry%do) then
          ie = user%entry%ientry
       else
          do iwhich=1,nwhich
             if (.not.user%which(iwhich)%do)  cycle
             select case (iwhich)
             case (izero)
                put = .false.
                ie = 0
             case (ifirst)
                ie = 1
             case (ilast)
                ie = cube%nentry()
             case (inext)
                ie = ie+1
             case (iprevious)
                ie = ie-1
             case (iafter)
                put = .false.
                ie = cube%nentry()+1
             case(icurrent)
                ! No change to ie
             end select
          enddo
       endif
       if (ie.lt.0) then
          call cubeedit_message(seve%e,rname,'Trying to put data before the start of the cube')
          error = .true.
          return
       elseif (ie.gt.cube%nentry()) then
          call cubeedit_message(seve%e,rname,'Trying to put data beyond number of entries')
          error = .true.
          return
       endif
       !
       if (put) then
          if (doimg) then
             if (cube%iscplx()) then
                call cubeedit_putdata_image_cplx(cube,user%varname,ie,error)
                if (error) return
             else
                call cubeedit_putdata_image_real(cube,user%varname,ie,error)
                if (error) return
             endif
          else
             if (cube%iscplx()) then
                call cubeedit_putdata_spectrum_cplx(cube,user%varname,ie,error)
                if (error) return
             else
                call cubeedit_putdata_spectrum_real(cube,user%varname,ie,error)
                if (error) return
             endif
          endif
       else
          ! Nothing to be put
       endif
    else
       ! Nothing to be done
    endif
  end subroutine cubeedit_putdata_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeedit_putdata_image_real(cube,varname,ie,error)
    use cube_types
    use cubetools_uservar
    use cubeadm_ioloop
    use cubemain_image_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cube_t), pointer, intent(inout) :: cube
    character(len=*),      intent(in)    :: varname
    integer(kind=entr_k),  intent(in)    :: ie
    logical,               intent(inout) :: error
    !
    type(uservar_t) :: var
    integer(kind=4) :: ndim
    integer(kind=entr_k), allocatable :: dims(:)
    integer(kind=pixe_k) :: nl,nm
    type(image_t) :: imag
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='PUT>DATA>IMAGE>REAL'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    nl = cube%head%arr%n%l
    nm = cube%head%arr%n%m
    !
    call cubetools_userspace_get('real',varname,var,error)
    if (error) return
    call var%get_dims(ndim,dims,error)
    if (error) return
    if (ndim.ne.2) then
       write(mess,'(a,i0,a)') 'Expected a 2D array got a ',ndim,'D array'
       call cubeedit_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    if (dims(1).ne.nl.or.dims(2).ne.nm) then
       write(mess,'(4(a,i0))') 'Expected a ',nl,'x',nm,' array got ',dims(1),'x',dims(2)
       call cubeedit_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    !
    call imag%reallocate('fromvar',nl,nm,error)
    if (error) return
    call var%get(imag%z,error)
    if (error) return
    call cubeadm_io_iterate(ie,ie,cube,error)
    if (error) return
    call imag%put(cube,ie,error)
    if (error) return
  end subroutine cubeedit_putdata_image_real
  !
  subroutine cubeedit_putdata_image_cplx(cube,varname,ie,error)
    use cube_types
    use cubetools_uservar
    use cubeadm_ioloop
    use cubemain_image_cplx
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cube_t), pointer, intent(inout) :: cube
    character(len=*),      intent(in)    :: varname
    integer(kind=entr_k),  intent(in)    :: ie
    logical,               intent(inout) :: error
    !
    type(uservar_t) :: var
    integer(kind=4) :: ndim
    integer(kind=entr_k), allocatable :: dims(:)
    integer(kind=pixe_k) :: nl,nm
    type(image_cplx_t) :: imag
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='PUT>DATA>IMAGE>CPLX'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    nl = cube%head%arr%n%l
    nm = cube%head%arr%n%m
    !
    call cubetools_userspace_get('complex',varname,var,error)
    if (error) return
    call var%get_dims(ndim,dims,error)
    if (error) return
    if (ndim.ne.2) then
       write(mess,'(a,i0,a)') 'Expected a 2D array got a ',ndim,'D array'
       call cubeedit_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    if (dims(1).ne.nl.or.dims(2).ne.nm) then
       write(mess,'(4(a,i0))') 'Expected a ',nl,'x',nm,' array got ',dims(1),'x',dims(2)
       call cubeedit_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    !
    call imag%reallocate('fromvar',nl,nm,error)
    if (error) return
    call var%get(imag%z,error)
    if (error) return
    call cubeadm_io_iterate(ie,ie,cube,error)
    if (error) return
    call imag%put(cube,ie,error)
    if (error) return
  end subroutine cubeedit_putdata_image_cplx
  !
  subroutine cubeedit_putdata_spectrum_real(cube,varname,ie,error)
    use cube_types
    use cubetools_uservar
    use cubeadm_ioloop
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cube_t), pointer, intent(inout) :: cube
    character(len=*),      intent(in)    :: varname
    integer(kind=entr_k),  intent(in)    :: ie
    logical,               intent(inout) :: error
    !
    type(uservar_t) :: var
    integer(kind=4) :: ndim
    integer(kind=entr_k), allocatable :: dims(:)
    integer(kind=pixe_k) :: nc
    type(spectrum_t) :: spec
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='PUT>DATA>SPECTRUM>REAL'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    nc = cube%head%arr%n%c
    !
    call cubetools_userspace_get('real',varname,var,error)
    if (error) return
    call var%get_dims(ndim,dims,error)
    if (error) return
    if (ndim.ne.1) then
       write(mess,'(a,i0,a)') 'Expected a 1D array got a ',ndim,'D array'
       call cubeedit_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    if (dims(1).ne.nc) then
       write(mess,'(2(a,i0))') 'Expected an array of size ',nc,' got ',dims(1)
       call cubeedit_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    !
    call spec%reallocate('fromvar',nc,error)
    if (error) return
    call var%get(spec%t,error)
    if (error) return
    call cubeadm_io_iterate(ie,ie,cube,error)
    if (error) return
    call spec%put(cube,ie,error)
    if (error) return
  end subroutine cubeedit_putdata_spectrum_real
  !
  subroutine cubeedit_putdata_spectrum_cplx(cube,varname,ie,error)
    use cube_types
    use cubetools_uservar
    use cubeadm_ioloop
    use cubemain_spectrum_cplx
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cube_t), pointer, intent(inout) :: cube
    character(len=*),      intent(in)    :: varname
    integer(kind=entr_k),  intent(in)    :: ie
    logical,               intent(inout) :: error
    !
    type(uservar_t) :: var
    integer(kind=4) :: ndim
    integer(kind=entr_k), allocatable :: dims(:)
    integer(kind=pixe_k) :: nc
    type(spectrum_cplx_t) :: spec
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='PUT>DATA>SPECTRUM>CPLX'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    nc = cube%head%arr%n%c
    !
    call cubetools_userspace_get('complex',varname,var,error)
    if (error) return
    call var%get_dims(ndim,dims,error)
    if (error) return
    if (ndim.ne.1) then
       write(mess,'(a,i0,a)') 'Expected a 1D array got a ',ndim,'D array'
       call cubeedit_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    if (dims(1).ne.nc) then
       write(mess,'(2(a,i0))') 'Expected an array of size ',nc,' got ',dims(1)
       call cubeedit_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    !
    call spec%reallocate('fromvar',nc,error)
    if (error) return
    call var%get(spec%t,error)
    if (error) return
    call cubeadm_io_iterate(ie,ie,cube,error)
    if (error) return
    call spec%put(cube,ie,error)
    if (error) return
  end subroutine cubeedit_putdata_spectrum_cplx
end module cubeedit_putdata
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
