!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_resample
  use cubetools_structure
  use cube_types
  use cubetools_header_types
  use cubetools_axis_types
  use cubedag_allflags
  use cubeadm_get
  use cubeadm_cubeid_types
  use cubemain_messaging
  use cubemain_auxiliary
  !
  public :: resample
  public :: cubemain_resample_command
  public :: cubemain_resample_data
  private
  !
  type :: resample_comm_t
     type(option_t), pointer :: comm      
     type(axis_opt_t)        :: faxis         
     type(axis_opt_t)        :: vaxis         
     type(option_t), pointer :: like
   contains
     procedure, public  :: register => cubemain_resample_register
     procedure, private :: parse    => cubemain_resample_parse
     procedure, private :: main     => cubemain_resample_main
  end type resample_comm_t
  type(resample_comm_t) :: resample
  !
  integer(kind=4), parameter :: icube = 1
  type resample_user_t
     type(cubeid_user_t)    :: cubeids
     type(auxiliary_user_t) :: like
     type(axis_user_t)      :: axis               ! [Mhz|km/s] User axis description
     logical                :: dofreq = .true.    ! Frequency or velocity axis definition?
   contains
     procedure, private :: toprog => cubemain_resample_user_toprog
  end type resample_user_t
  type resample_prog_t
     type(cube_header_t)   :: inhead          ! Frequency or velocity modified version of input cube header
     type(cube_t), pointer :: refcube         ! Cube given with /LIKE
     type(cube_t), pointer :: incube          ! Input cube
     type(cube_t), pointer :: resampled       ! Resampled cube
     type(axis_user_t)     :: uaxis           ! [Mhz|km/s] User axis description
     logical               :: dofreq = .true. ! Resample in frequency or in velocity space?
     logical               :: dolike
   contains
     procedure, private :: header => cubemain_resample_prog_header
  end type resample_prog_t
  !
contains
  !
  subroutine cubemain_resample_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)  :: line
    logical,          intent(out) :: error
    !
    type(resample_user_t) :: user
    character(len=*), parameter :: rname='RESAMPLE>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call resample%parse(line,user,error)
    if (error) return
    call resample%main(user,error)
    if (error) continue
  end subroutine cubemain_resample_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_resample_register(resample,error)
    use cubetools_unit
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(resample_comm_t), intent(inout) :: resample
    logical,                intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    character(len=*), parameter :: comm_abstract = &
         'Resample a cube spectrally'
    character(len=*), parameter :: comm_help = &
         'The resampling can be done on the velocity or frequency&
         & axes.'
    character(len=*), parameter :: rname='RESAMPLE>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'RESAMPLE','[cube]',&
         comm_abstract,&
         comm_help,&
         cubemain_resample_command,&
         resample%comm,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         'Signal cube',  &
         strg_id,&
         code_arg_optional,  &
         [flag_cube], &
         error)
    if (error) return
    !
    call resample%faxis%register(&
         code_unit_freq,&
         'FAXIS',&
         'Define the frequency axis of the resampled cube',&
         error)
    if (error) return
    !
    call resample%vaxis%register(&
         code_unit_velo,&
         'VAXIS',&
         'Define the velocity axis of the resampled cube',&
         error)
    if (error) return
    !
    call cubemain_auxiliary_register(&
         'LIKE',&
         'Resample onto the same spectral grid as a reference cube',&
         strg_id,&
         'Reference cube',&
         [flag_cube],&
         code_arg_mandatory, &
         resample%like,error)
    if (error) return
  end subroutine cubemain_resample_register
  !
  subroutine cubemain_resample_parse(resample,line,user,error)
    !----------------------------------------------------------------------
    ! RESAMPLE cubname
    !   /FAXIS nc ref val inc
    !   /VAXIS nc ref val inc
    !   /LIKE refcube
    !----------------------------------------------------------------------
    class(resample_comm_t), intent(in)    :: resample
    character(len=*),       intent(in)    :: line
    type(resample_user_t),  intent(out)   :: user
    logical,                intent(out)   :: error
    !
    integer(kind=opti_k) :: nopt
    logical :: dovaxis
    character(len=*), parameter :: rname='RESAMPLE>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,resample%comm,user%cubeids,error)
    if (error) return
    nopt = cubetools_nopt()
    if (nopt.gt.1) then
       call cubemain_message(seve%e,rname,'/FAXIS, /VAXIS, and /LIKE are mutually exclusive options')
       error = .true.
       return
    else if (nopt.eq.0) then
       call cubemain_message(seve%w,rname,'No options given => Making a copy of the input cube')
       user%dofreq = .true.
    endif
    call cubemain_auxiliary_parse(line,resample%like,user%like,error)
    if (error) return
    !
    call resample%faxis%opt%present(line,user%dofreq,error)
    if (error) return
    call resample%vaxis%opt%present(line,dovaxis,error)
    if (error) return
    if (user%dofreq) then
       call resample%faxis%parse(line,user%axis,error)
       if (error) return
    else if (user%like%do) then
       ! Default is to resample in frequency
       user%dofreq = .true. 
    else if (dovaxis) then
       call resample%vaxis%parse(line,user%axis,error)
       if (error) return
    else
       call cubemain_message(seve%e,rname,'Option handling error')
       error = .true.
       return
    endif
  end subroutine cubemain_resample_parse
  !
  subroutine cubemain_resample_main(resample,user,error)
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(resample_comm_t), intent(in)    :: resample
    type(resample_user_t),  intent(in)    :: user
    logical,                intent(inout) :: error
    !
    type(resample_prog_t) :: prog
    character(len=*), parameter :: rname='RESAMPLE>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(prog,error)
    if (error) goto 10
    call prog%header(error)
    if(error) goto 10
    call cubeadm_timing_prepro2process()
    call cubemain_resample_data(prog%inhead,prog%incube,prog%resampled,error)
    if(error) goto 10
    call cubeadm_timing_process2postpro()
    !
10  continue
    call cubetools_header_final(prog%inhead,error)
  end subroutine cubemain_resample_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_resample_user_toprog(user,prog,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(resample_user_t), intent(in)    :: user
    type(resample_prog_t),  intent(out)   :: prog
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='RESAMPLE>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_get_header(resample%comm,icube,user%cubeids,code_access_speset,&
         code_read,prog%incube,error)
    if (error) return
    prog%dofreq = user%dofreq
    !
    prog%dolike = user%like%do
    if (prog%dolike) then
       call cubemain_auxiliary_user2prog(resample%like,code_access_imaset_or_speset,  &
            user%like,prog%refcube,error)
       if (error) return
    else
       prog%uaxis = user%axis
    endif
  end subroutine cubemain_resample_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_resample_prog_header(prog,error)
    use cubetools_header_methods
    use cubeadm_clone
    !----------------------------------------------------------------------
    ! Get input header and modify spectroscopy related parts of the header
    ! according to user wishes
    !----------------------------------------------------------------------
    class(resample_prog_t), intent(inout) :: prog
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='RESAMPLE>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Start by deriving a consistent output header
    call cubeadm_clone_header(prog%incube,&
         [flag_resample,flag_cube],&
         prog%resampled,&
         error)
    if (error) return
    if (prog%dolike) then
       call cubetools_header_spectral_like(prog%refcube%head,prog%resampled%head,error)
       if (error) return
    else
       if (prog%dofreq) then
          call cubetools_header_update_frequency_from_user(prog%uaxis,prog%resampled%head,error)
          if (error) return
       else
          call cubetools_header_update_velocity_from_user(prog%uaxis,prog%resampled%head,error)
          if (error) return
       endif   
    endif
    ! Continue by modifying the input header rest frequency or velocity frame
    ! This can not be done in place => We first copy
    call cubetools_header_copy(prog%incube%head,prog%inhead,error)
    if (error) return
    if (prog%dofreq) then
       call cubetools_header_modify_rest_frequency(prog%resampled%head%spe%ref%f,prog%inhead,error)
       if (error) return
    else
       call cubetools_header_modify_frame_velocity(prog%resampled%head%spe%ref%v,prog%inhead,error)
       if (error) return
    endif
  end subroutine cubemain_resample_prog_header
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_resample_data(inhead,incube,oucube,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cube_header_t),   intent(in)    :: inhead
    type(cube_t),          intent(inout) :: incube
    type(cube_t),          intent(inout) :: oucube
    logical,               intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='RESAMPLE>DATA'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    !$OMP parallel default(none) shared(inhead,incube,oucube,error) firstprivate(iter)
    !$OMP single
    do while (cubeadm_dataiterate_all(iter,error))
       if (error)  exit
       !$OMP task
       if (.not.error) &
            call cubemain_resample_spectrum_loop(inhead,incube,oucube,iter%first,iter%last,error)
       !$OMP end task
    enddo ! ie
    !$OMP end single
    !$OMP end parallel
  end subroutine cubemain_resample_data
  !
  subroutine cubemain_resample_spectrum_loop(inhead,incube,oucube,first,last,error)
    use cubeadm_entryloop
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cube_header_t),   intent(in)    :: inhead
    type(cube_t),          intent(inout) :: incube
    type(cube_t),          intent(inout) :: oucube
    integer(kind=entr_k),  intent(in)    :: first
    integer(kind=entr_k),  intent(in)    :: last
    logical,               intent(inout) :: error
    !
    integer(kind=entr_k) :: ie
    type(spectrum_t) :: inspec,ouspec
    character(len=*), parameter :: rname='RESAMPLE>SPECTRUM>LOOP'
    !
    call inspec%reallocate('in spectrum',incube%head%arr%n%c,error)
    if (error)  return
    call ouspec%reallocate('resampled',oucube%head%arr%n%c,error)
    if (error)  return
    !
    do ie=first,last
       call cubeadm_entryloop_iterate(ie,error)
       if (error)  return
       call cubemain_resample_spectrum(inhead,incube,oucube,ie,inspec,ouspec,error)
       if (error)  return
    enddo
  end subroutine cubemain_resample_spectrum_loop
  !
  subroutine cubemain_resample_spectrum(inhead,incube,oucube,ie,inspec,ouspec,error)
    use cubemain_spectrum_real
    use cubemain_spectrum_resampling
    !----------------------------------------------------------------------
    ! Resampling always done on frequency axis as all axis are made
    ! coherent
    ! ----------------------------------------------------------------------
    type(cube_header_t),   intent(in)    :: inhead
    type(cube_t),          intent(inout) :: incube
    type(cube_t),          intent(inout) :: oucube
    integer(kind=entr_k),  intent(in)    :: ie
    type(spectrum_t),      intent(inout) :: inspec ! Working buffer
    type(spectrum_t),      intent(inout) :: ouspec ! Working buffer
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='RESAMPLE>SPECTRUM'
    !
    inspec%w = 1.0
    call inspec%get(incube,ie,error)
    if (error)  return
    call cubemain_spectrum_resample(inhead%spe%f,oucube%head%spe%f,inspec,ouspec,error)
    if (error)  return
    call ouspec%put(oucube,ie,error)
    if (error)  return
  end subroutine cubemain_resample_spectrum
  !
end module cubemain_resample
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
