!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_resample
  use cube_types
  use cubetools_axis_types
  use cubetools_header_types
  use cubetools_structure
  use cubetopology_cuberegion_types  
  use cubeadm_cubeid_types
  use cubeadm_cubeprod_types
  use cubemain_messaging
  use cubemain_ancillary_refhead_types
  !
  public :: resample
  public :: resample_user_t
  private
  !
  type :: resample_comm_t
     type(option_t), pointer        :: comm
!     type(cuberegion_comm_t)        :: region
     type(axis_opt_t)               :: faxis         
     type(axis_opt_t)               :: vaxis         
     type(ancillary_refhead_comm_t) :: reference
     type(cubeid_arg_t), pointer    :: incube
     type(cube_prod_t),  pointer    :: resampled
   contains
     procedure, public  :: register => cubemain_resample_comm_register
     procedure, private :: parse    => cubemain_resample_comm_parse
     procedure, public  :: main     => cubemain_resample_comm_main
  end type resample_comm_t
  type(resample_comm_t) :: resample
  !
  type resample_user_t
     type(cubeid_user_t)            :: cubeids
     type(ancillary_refhead_user_t) :: reference
!     type(cuberegion_user_t)        :: region
     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_t), pointer          :: incube    ! Input cube
     type(ancillary_refhead_prog_t) :: reference ! Input reference cube
     type(cube_t), pointer          :: resampled ! Output resampled cube
!     type(cuberegion_prog_t) :: region
     type(axis_user_t)       :: uaxis           ! [Mhz|km/s] User axis description
     logical                 :: dofreq = .true. ! Resample in frequency or in velocity space?
     logical                 :: dolike
     type(cube_header_t)     :: inhead          ! Frequency or velocity modified version of input cube header
   contains
     procedure, private :: header => cubemain_resample_prog_header
     procedure, private :: data   => cubemain_resample_prog_data
     procedure, private :: loop   => cubemain_resample_prog_loop
     procedure, private :: act    => cubemain_resample_prog_act
  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_comm_register(comm,error)
    use cubetools_unit
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(resample_comm_t), intent(inout) :: comm
    logical,                intent(inout) :: error
    !
    type(cubeid_arg_t) :: incube
    type(cube_prod_t) :: oucube
    character(len=*), parameter :: comm_abstract='Spectrally resample a cube'
    character(len=*), parameter :: comm_help=&
         'The resampling can be done on the velocity or frequency&
         & axes.'
    character(len=*), parameter :: rname='RESAMPLE>COMM>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Syntax
    call cubetools_register_command(&
         'RESAMPLE','[cubeid]',&
         comm_abstract,&
         comm_help,&
         cubemain_resample_command,&
         comm%comm,&
         error)
    if (error) return
    call incube%register(&
         'INPUT',&
         'Signal cube',&
         strg_id,&
         code_arg_optional,&
         [flag_cube],&
         code_read,&
         code_access_speset,&
         comm%incube,&
         error)
    if (error) return
    call comm%reference%register('RESAMPLE',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 comm%region%register(error)
!!$    if (error) return
    !
    ! Products
    call oucube%register(&
         'RESAMPLED',&
         'Resampled cube',&
         strg_id,&
         [flag_resampled,flag_cube],&
         comm%resampled,&
         error)
    if (error)  return
  end subroutine cubemain_resample_comm_register
  !
  subroutine cubemain_resample_comm_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! RESAMPLE cubeid
    !   /FAXIS nc ref val inc
    !   /VAXIS nc ref val inc
    !   /LIKE refcube
    !----------------------------------------------------------------------
    class(resample_comm_t), intent(in)    :: comm
    character(len=*),       intent(in)    :: line
    type(resample_user_t),  intent(out)   :: user
    logical,                intent(out)   :: error
    !
    integer(kind=opti_k) :: nopt ! ***JP: Why here?
    logical :: dovaxis
    character(len=*), parameter :: rname='RESAMPLE>COMM>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,comm%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 comm%reference%parse(line,user%reference,error)
    if (error) return
    !
    call comm%faxis%opt%present(line,user%dofreq,error)
    if (error) return
    call comm%vaxis%opt%present(line,dovaxis,error)
    if (error) return
    if (user%dofreq) then
       call comm%faxis%parse(line,user%axis,error)
       if (error) return
    else if (user%reference%present) then
       ! Default is to resample in frequency
       user%dofreq = .true. 
    else if (dovaxis) then
       call comm%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_comm_parse
  !
  subroutine cubemain_resample_comm_main(comm,user,error)
    use cubeadm_timing
    !----------------------------------------------------------------------
    ! ***JP: Non-standard for the moment because of header_final.
    !----------------------------------------------------------------------
    class(resample_comm_t), intent(in)    :: comm
    type(resample_user_t),  intent(in)    :: user
    logical,                intent(inout) :: error
    !
    type(resample_prog_t) :: prog
    character(len=*), parameter :: rname='RESAMPLE>COMM>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(comm,prog,error)
    if (error) goto 10
    call prog%header(comm,error)
    if (error) goto 10
    call cubeadm_timing_prepro2process()
    call prog%data(error)
    if (error) goto 10
    call cubeadm_timing_process2postpro()
    !
10  continue
    call cubetools_header_final(prog%inhead,error)
  end subroutine cubemain_resample_comm_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_resample_user_toprog(user,comm,prog,error)
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(resample_user_t), intent(in)    :: user
    type(resample_comm_t),  intent(in)    :: comm
    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(comm%incube,user%cubeids,prog%incube,error)
    if (error) return
!!$    call user%region%toprog(prog%incube,prog%region,error)
!!$    if (error) return
    !
    call user%reference%toprog(comm%reference,prog%reference,error)
    if (error) return
    if (.not.prog%reference%do) then
       prog%uaxis = user%axis
    endif
    !
    prog%dofreq = user%dofreq
    !
    ! User feedback about the interpretation of his command line
!!$    call prog%region%list(error)
!!$    if (error) return
  end subroutine cubemain_resample_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_resample_prog_header(prog,comm,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
    type(resample_comm_t),  intent(in)    :: comm
    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(comm%resampled,prog%incube,prog%resampled,error)
    if (error) return
!    call prog%region%header(prog%resampled,error)
!    if (error) return
    if (prog%reference%do) then
       call cubetools_header_spectral_like(prog%reference%cube%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_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(resample_prog_t), intent(inout) :: prog
    logical,                intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='RESAMPLE>PROG>DATA'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    !$OMP PARALLEL default(none) SHARED(prog,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))
       if (error) exit
       !$OMP TASK SHARED(prog,error) FIRSTPRIVATE(iter)
       if (.not.error) &
          call prog%loop(iter,error)
       !$OMP END TASK
    enddo ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubemain_resample_prog_data
  !
  subroutine cubemain_resample_prog_loop(prog,iter,error)
    use cubeadm_taskloop
    use cubeadm_spectrum_types
    use cubemain_resample_spectrum_tool
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(resample_prog_t),   intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(resample_spectrum_prog_t) :: resample
    type(spectrum_t) :: inspe,respe
    character(len=*), parameter :: rname='RESAMPLE>PROG>LOOP'
    !
    call inspe%associate('Input spectrum',prog%incube,iter,error)
    if (error) return
    call inspe%allocate_w(error)
    if (error) return
    call respe%allocate('Resampled spectrum',prog%resampled,iter,error)
    if (error) return
    call resample%init(inspe,respe,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
       call prog%act(iter%ie,resample,inspe,respe,error)
       if (error) return
    enddo ! ie
  end subroutine cubemain_resample_prog_loop
  !
  subroutine cubemain_resample_prog_act(prog,ie,resample,inspe,respe,error)
    use cubeadm_spectrum_types
    use cubemain_resample_spectrum_tool
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(resample_prog_t),         intent(inout) :: prog
    integer(kind=entr_k),           intent(in)    :: ie
    type(resample_spectrum_prog_t), intent(in)    :: resample
    type(spectrum_t),               intent(inout) :: inspe
    type(spectrum_t),               intent(inout) :: respe
    logical,                        intent(inout) :: error
    !
    character(len=*), parameter :: rname='RESAMPLE>PROG>ACT'
    !
    inspe%w%val(:) = 1.0 ! ***JP: For the moment
    call inspe%get(ie,error)
    if (error) return
    call resample%spectrum(inspe,respe,error)
    if (error) return
    call respe%put(ie,error)
    if (error) return
  end subroutine cubemain_resample_prog_act
end module cubemain_resample
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
