!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubego_oldget
  use cubetools_structure
  use cubetools_keyword_arg
  use cube_types
  use cubemain_image_real
  use cubemain_spectrum_real
  use cubego_messaging
  use cubego_oldload
  !
  public :: cubego_oldget_command,cubego_oldget_register
  private
  !
  type :: get_comm_t
     type(option_t),      pointer :: get
     type(keyword_arg_t), pointer :: which_arg
     type(option_t),      pointer :: from  
     type(option_t),      pointer :: into
  end type get_comm_t
  type(get_comm_t) :: comm
  !
  type get_user_t
     character(len=argu_l) :: argu
     logical               :: dofrom
     character(len=varn_l) :: fromname = blankstr
     logical               :: dointo
     character(len=varn_l) :: intoname = blankstr
  end type get_user_t
  !
  type get_prog_t
     character(len=varn_l) :: fromname = blankstr
     character(len=varn_l) :: intoname = blankstr
     integer(kind=entr_k)  :: ie
     integer(kind=4)       :: icub
     logical               :: get
     type(cube_t), pointer :: cube
  end type get_prog_t
  !
  type get_data_t
     integer(kind=entr_k)  :: ie   = 0
     integer(kind=code_k)  :: code = code_null
     type(spectrum_t)      :: spe
     type(image_t)         :: ima
     integer(kind=4)       :: icub
     logical               :: used=.false.
     character(len=varn_l) :: name
  end type get_data_t
  !
  integer(kind=4), parameter :: mentry=16  ! Maximum number of entries we can GET at a time
  type(get_data_t) :: getlist(mentry)
  !
contains
  !
  subroutine cubego_oldget_register(error)
    use cubetools_structure
    !-------------------------------------------------------------------
    ! Register SET\GET command and its options
    !-------------------------------------------------------------------
    logical,          intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    type(keyword_arg_t) :: keyarg
    character(len=*), parameter :: comm_abstract = &
         'Get IMAGES or SPECTRA from a loaded cube'
    character(len=*), parameter :: comm_help = &
         'The data fetched depend on the access chose for the cube&
         & (GO\LOAD /ACCESS), Images or spectra are loaded in the named&
         & variable (/INTO). Data is fetched from the named cube (/FROM).'
    integer(kind=4), parameter :: nactions=5
    character(len=*), parameter :: actions(nactions) = &
         ['NEXT    ','PREVIOUS','FIRST   ','LAST    ','ZERO    ']
    character(len=*), parameter :: rname='GET>REGISTER'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'OLDGET','which',&
         comm_abstract,&
         comm_help,&
         cubego_oldget_command,&
         comm%get,error)
    if (error) return
    call keyarg%register( &
         'which',  &
         'Which entry of the cube is to be gotten', &
         'FIRST: The first entry; LAST: the last entry; NEXT the next&
         & entry; PREVIOUS; the previous entry, ZERO: No entry is&
         & fetched internal entry counter is reset to zero; ient:&
         & Entry number, for images is the image channel, for spectra&
         & ient = ix+(iy-1)*nx',&
         code_arg_mandatory,&
         actions, &
         flexible, &
         comm%which_arg,&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'FROM','varname',&
         'Choose from which loaded CUBE to get data',&
         strg_id,&
         comm%from,error)
    if (error) return
    call stdarg%register( &
         'varname',  &
         'Which cube is to be used', &
         strg_id,&
         code_arg_mandatory, &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'INTO','varname',&
         'Choose to which variable the data has to be loaded',&
         strg_id,&
         comm%into,error)
    if (error) return
    call stdarg%register( &
         'varname',  &
         'Where the data is loaded', &
         strg_id,&
         code_arg_mandatory, &
         error)
    if (error) return
  end subroutine cubego_oldget_register
  !
  subroutine cubego_oldget_command(line,error)
    !-------------------------------------------------------------------
    ! Support routine for command GET
    !
    ! Data is loaded into fromname%ima or fromname%spe depending on the
    ! access order
    ! -------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>COMMAND'
    type(get_user_t) :: user
    type(get_prog_t) :: prog
    integer(kind=4) :: iget
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    call cubego_oldget_parse(line,user,error)
    if (error) return
    call cubego_oldget_getslot(user%intoname,getlist,iget,error)
    if (error) return
    call cubego_oldget_user2prog(user,prog,getlist(iget),error)
    if (error) return
    call cubego_oldget_main(prog,getlist(iget),error)
    if (error) return
  end subroutine cubego_oldget_command
  !
  subroutine cubego_oldget_parse(line,user,error)
    !-------------------------------------------------------------------
    ! GET NEXT|PREV|FIRST|LAST|ZERO|ient [/FROM varname ]
    ! /FROM varname (default is last one loaded)
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    type(get_user_t), intent(out)   :: user
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>PARSE'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    call cubetools_getarg(line,comm%get,1,user%argu,mandatory,error)
    if(error) return
    !
    call comm%from%present(line,user%dofrom,error)
    if (error) return
    if (user%dofrom) then
       call cubetools_getarg(line,comm%from,1,user%fromname,mandatory,error)
       if (error) return
    else
       ! ZZZ Is there an API for "mandatory options"?
       call cubego_message(seve%e,rname,'Missing option /FROM')
       error = .true.
       return
    endif
    !
    call comm%into%present(line,user%dointo,error)
    if (error) return
    if (user%dointo) then
       call cubetools_getarg(line,comm%into,1,user%intoname,mandatory,error)
       if(error) return
    else
       ! ZZZ Is there an API for "mandatory options"?
       call cubego_message(seve%e,rname,'Missing option /INTO')
       error = .true.
       return
    endif
  end subroutine cubego_oldget_parse
  !
  subroutine cubego_oldget_user2prog(user,prog,getdata,error)
    use cubetools_user2prog
    use cubetools_disambiguate
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(get_user_t), intent(in)    :: user
    type(get_prog_t), intent(inout) :: prog
    type(get_data_t), intent(inout) :: getdata
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>USER2PROG'
    character(len=argu_l) :: action
    integer(kind=entr_k) :: uie
    integer(kind=4) :: ikey
    character(len=varn_l) :: fromname
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    call cubetools_disambiguate_toupper(user%fromname,fromname,error)
    if (error) return
    call cubego_oldload_getcube_number(user%dofrom,fromname,prog%icub,error)
    if (error) return
    call cubego_oldload_getcube_pointer(prog%icub,prog%cube,error)
    if (error) return
    ! VVV Case we are switching cubes
    if (prog%icub.ne.getdata%icub) then
       getdata%ie = 0
    endif
    !
    prog%fromname = proglist(prog%icub)%var%name
    if(.not.proglist(prog%icub)%dohead) then
       call cubego_message(seve%e,rname,'Cannot get data from a cube loaded with /SYNTAX HGDF')
       error = .true.
       return
    endif
    !
    prog%get = .true.
    prog%intoname = user%intoname
    call cubetools_keyword_user2prog(comm%which_arg,user%argu,ikey,action,error)
    if (error) return
    if (action.eq.strg_unresolved) then
       uie = getdata%ie
       call cubetools_user2prog_resolve_star(user%argu,getdata%ie,uie,error)
       if (error) return
       action = 'NONE'
    endif
    if (error) return
    select case(trim(action))
    case('NEXT')
       prog%ie = getdata%ie+1
    case('PREVIOUS')
       prog%ie = getdata%ie-1
    case('FIRST')
       prog%ie = 1
    case('LAST')
       prog%ie = prog%cube%nentry()
    case('ZERO')
       prog%ie = 0
       prog%get = .false.
    case('NONE')
       if (uie.gt.0) then
          prog%ie = uie
       else
          call cubego_message(seve%e,rname,'Entry number must be positive')
          error = .true.
          return
       endif
    case default
       call cubego_message(seve%e,rname,'Unknown action '//trim(action))
       error = .true.
       return
    end select
  end subroutine cubego_oldget_user2prog
  !
  subroutine cubego_oldget_getslot(varname,getlist,iget,error)
    use sic_types
    !-------------------------------------------------------------------
    ! Return a free 'slot' to be used for loading the entry
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: varname
    type(get_data_t), intent(inout) :: getlist(:)
    integer(kind=4),  intent(out)   :: iget
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>GETSLOT'
    logical :: found
    type(sic_descriptor_t) :: desc
    !
    ! First, search if one has to be overwritten
    iget = cubego_oldget_varindex(varname,getlist)
    if (iget.gt.0) then
      ! Found one in use with the correct name. Free it and return
      ! its number for reuse
      call cubego_oldget_clean(getlist(iget),error)
      return
    endif
    !
    ! Remove SIC variable to be overwritten (if any), take care of
    ! read-only ones (e.g. PI)
    found = .false.  ! Quiet
    call sic_descriptor(varname,desc,found)
    if (found) then
      if (desc%readonly) then
        call cubego_message(seve%e,rname,'Can not delete read-only variable '//varname)
        error = .true.
        return
      endif
      call sic_delvariable(varname,.false.,error)
      if (error) return
    endif
    !
    ! Else, just find a free slot
    do iget=1,size(getlist)
      if (.not.getlist(iget)%used)  return
    enddo
    !
    ! No free slot found
    call cubego_message(seve%e,rname,'Maximum number of buffers exhausted')
    error = .true.
    return
  end subroutine cubego_oldget_getslot
  !
  function cubego_oldget_varindex(varname,getlist) result(varindex)
    !-------------------------------------------------------------------
    ! Return the index for which the entry is mapped to the named
    ! variable. Return 0 if not found.
    !-------------------------------------------------------------------
    integer(kind=4)              :: varindex
    character(len=*), intent(in) :: varname
    type(get_data_t), intent(in) :: getlist(:)
    ! Local
    integer(kind=4) :: iget
    character(len=varn_l) :: uvarname
    !
    do iget=1,size(getlist)
      if (.not.getlist(iget)%used)         cycle
      uvarname = varname
      call sic_upper(uvarname)
      if (getlist(iget)%name.ne.uvarname)  cycle
      varindex = iget
      return
    enddo
    varindex = 0
  end function cubego_oldget_varindex
  !
  subroutine cubego_oldget_clean(getdata,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Clean current contents of the GET prog structure
    !-------------------------------------------------------------------
    type(get_data_t), intent(inout) :: getdata
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>CLEAN'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    call sic_delvariable(getdata%name,.false.,error)
    if (error)  error = .false.
    getdata%used = .false.
  end subroutine cubego_oldget_clean
  !
  subroutine cubego_oldget_main(prog,getdata,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(get_prog_t), intent(in)    :: prog
    type(get_data_t), intent(inout) :: getdata
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>MAIN'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    if (prog%get) then
       call cubego_oldget_getdata(prog,getdata,error)
       if (error) return
       call cubego_oldget_sicdef(prog,getdata,error)
       if (error) return
    else
       getdata%ie = 0
    endif
  end subroutine cubego_oldget_main
  !
  subroutine cubego_oldget_getdata(prog,getdata,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(get_prog_t), intent(in)    :: prog
    type(get_data_t), intent(inout) :: getdata
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>GETDATA'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    if (prog%ie.lt.1) then
       call cubego_message(seve%e,rname,'Trying to fetch from before the start of the cube')
       error = .true.
       return
    endif
    if (prog%ie.gt.prog%cube%nentry()) then
       call cubego_message(seve%e,rname,'Trying to fetch data beyond number of entries')
       error = .true.
       return
    endif
    !
    if (prog%cube%order().eq.code_cube_imaset) then
      call cubego_oldget_image(prog,getdata,error)
      if (error) return
    else if (prog%cube%order().eq.code_cube_speset) then
      call cubego_oldget_spectrum(prog,getdata,error)
      if (error) return
    else
      call cubego_message(seve%e,rname,'Unhandled access on cube loaded in '//trim(prog%fromname))
      error = .true.
      return
    endif
    !
    ! Close the cube (to avoid consumption of limited resources like GIO slots)
    ! but do not free it (cube buffers are useful in iterating get context)
    call prog%cube%close(error)
    if (error)  return
    !
  end subroutine cubego_oldget_getdata
  !  
  subroutine cubego_oldget_spectrum(prog,getdata,error)
    use cubeadm_ioloop
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(get_prog_t), intent(in)    :: prog
    type(get_data_t), intent(inout) :: getdata
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>SPECTRUM'
    type(spectrum_t) :: locspe
    integer(kind=chan_k) :: nc
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    nc = prog%cube%head%arr%n%c
    call getdata%spe%reallocate('spectrum',nc,error)
    if (error) return
    call locspe%reassociate_and_init(prog%cube,error)
    if (error) return
    call cubeadm_io_iterate(int(prog%ie,entr_k),int(prog%ie,entr_k),prog%cube,error)
    if (error) return
    call locspe%get(prog%cube,prog%ie,error)
    if (error) return
    getdata%spe%t(:) = locspe%t(:)
    getdata%ie = prog%ie
    getdata%code = code_cube_speset
    getdata%icub = prog%icub
    getdata%used = .true.
  end subroutine cubego_oldget_spectrum
  !
  subroutine cubego_oldget_image(prog,getdata,error)
    use cubeadm_ioloop
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(get_prog_t), intent(in)    :: prog
    type(get_data_t), intent(inout) :: getdata
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>IMAGE'
    type(image_t) :: locima
    integer(kind=pixe_k) :: nl,nm
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    nl = prog%cube%head%arr%n%l
    nm = prog%cube%head%arr%n%m
    call getdata%ima%reallocate('image',nl,nm,error)
    if (error) return
    call locima%init(prog%cube,error)
    if (error) return
    call cubeadm_io_iterate(int(prog%ie,entr_k),int(prog%ie,entr_k),prog%cube,error)
    if (error) return
    call locima%get(prog%cube,prog%ie,error)
    if (error) return
    getdata%ima%z(:,:) = locima%z(:,:)
    getdata%ie = prog%ie
    getdata%code = code_cube_imaset
    getdata%icub = prog%icub
    getdata%used = .true.
    call cubego_oldget_image_into_rg(prog%cube%head,getdata%ima,error)
    if(error) return
  end subroutine cubego_oldget_image
  !
  subroutine cubego_oldget_image_into_rg(head,ima,error)
    use gkernel_interfaces
    use cubetools_unit
    use cubetools_axis_types
    use cubetools_header_types
    use cubetools_header_methods
    use cubemain_image_real
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(cube_header_t), intent(in)    :: head
    type(image_t),       intent(in)    :: ima
    logical,             intent(inout) :: error
    !
    logical :: iswcs 
    integer(kind=4) :: nx,ny ! Here nm and nl are int*4 because of the interfaces with gkernel
    real(kind=coor_k) :: conv(6),proj(3)
    type(axis_t) :: axis
    character(len=*), parameter :: rname='GET>IMAGE>INTO>RG'
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    ! Give data to RG
    call cubetools_header_get_axis_head_l(head,axis,error)
    if (error) return
    iswcs = axis%kind.eq.code_unit_fov
    nx = axis%n
    conv(1:3) = axis%conv
    call cubetools_header_get_axis_head_m(head,axis,error)
    if (error) return    
    iswcs = iswcs.and.(axis%kind.eq.code_unit_fov)
    ny = axis%n
    conv(4:6) = axis%conv
    call gr4_tgive(nx,ny,conv,ima%z)
    !
    ! Define blanking, since now we use NaNs bval=0 and eval=-1
    call gr8_blanking(0.d0,-1.d0)
    !
    if (iswcs) then
       ! Pass coordinate System
       call gr8_system(head%spa%fra%code,error,head%spa%fra%equinox)
       ! Pass projection
       proj(1) = head%spa%pro%l0
       proj(2) = head%spa%pro%m0
       proj(3) = head%spa%pro%pa
       call greg_projec(head%spa%pro%code,proj)
    else
       continue
    endif
  end subroutine cubego_oldget_image_into_rg
  !
  subroutine cubego_oldget_sicdef(prog,getdata,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(get_prog_t), intent(in)    :: prog
    type(get_data_t), intent(inout) :: getdata
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='GET>SICDEF'
    integer(kind=chan_k) :: nc
    integer(kind=pixe_k) :: dims(2)
    character(len=mess_l) :: mess
    integer(kind=4) :: ppos
    !
    call cubego_message(goseve%trace,rname,'Welcome')
    !
    getdata%name = prog%intoname
    call sic_upper(getdata%name)
    !
    ! Check if parent structure exists
    ! ZZZ There should be a SIC API for this...
    ppos = index(getdata%name,'%',back=.true.)
    if (ppos.gt.0) then
      if (.not.sic_varexist(getdata%name(1:ppos-1))) then
        call cubego_message(seve%e,rname,'Parent structure '//  &
          getdata%name(1:ppos-1)//' does not exist')
        error = .true.
        return
      endif
    endif
    !
    if (getdata%code.eq.code_cube_speset) then
       nc = prog%cube%head%arr%n%c
       call sic_def_real(getdata%name,getdata%spe%t,1,nc,.not.readonly,error)
       if (error)  return
       write(mess,'(a,i0,a)') 'Got spectrum ',prog%ie,' from '//trim(prog%fromname)//' in '//trim(getdata%name)
    else if (getdata%code.eq.code_cube_imaset) then
       dims(1) = prog%cube%head%arr%n%l
       dims(2) = prog%cube%head%arr%n%m
       call sic_def_real(getdata%name,getdata%ima%z,2,dims,.not.readonly,error)
       if (error)  return
       write(mess,'(a,i0,a)') 'Got image ',prog%ie,' from '//trim(prog%fromname)//' in '//trim(getdata%name)
    else 
       call cubego_message(seve%e,rname,'Unhandled access on cube loaded in '//trim(getdata%name))
       error = .true.
       return
    endif
    ! *** JP: Instead of this debugging message, it could be more useful to
    ! *** JP: have the number of the channel or pixel in the SIC structure.
    call cubego_message(goseve%others,rname,mess)
  end subroutine cubego_oldget_sicdef
end module cubego_oldget
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
