!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_merging
  use cubetools_parameters
  use cubetools_structure
  use cubetools_axis_types
  use cubetools_keywordlist_types
  use cubetools_spapro_types
  use cube_types
  use cubeadm_cubeid_types
  use cubeadm_cubeprod_types
  use cubeadm_index
  use cubemain_messaging
  use cubemain_auxiliary
  use cubetopology_speline_types
  use cubeadm_identifier
  use cubemain_average_tool
  !---------------------------------------------------------------------
  ! Support module for commands which need to reproject+resample cubes
  ! from an index before "merging" them (typical use case is averaging
  ! them, but other uses might be implemented thanks to the proper
  ! switch).
  !---------------------------------------------------------------------
  !
  public :: merging_comm_t, merging_user_t, merging_prog_t
  private
  !
  integer(kind=4), parameter :: ione = 1
  !
  integer(kind=code_k), parameter :: align_freq = 1
  integer(kind=code_k), parameter :: align_velo = 2
  integer(kind=code_k), parameter :: align_chan = 3
  character(len=*), parameter :: atype(3)=['FREQUENCY','VELOCITY ','CHANNEL  ']
  !
  integer(kind=code_k), parameter :: combi_union = 1
  integer(kind=code_k), parameter :: combi_inter = 2
  character(len=*), parameter :: ctype(2)=['UNION       ','INTERSECTION']
  !
  integer(kind=code_k), parameter :: kind_data=1
  integer(kind=code_k), parameter :: kind_weight=2
  integer(kind=code_k), parameter :: kind_noise=3
  !
  type merging_comm_t
     type(identifier_opt_t)       :: family
     type(option_t),      pointer :: like
     type(cubeid_arg_t),  pointer :: like_arg
     type(axis_opt_t)             :: faxis
     type(axis_opt_t)             :: vaxis
     type(speline_opt_t)          :: freq
     type(spapro_type_opt_t)      :: ptype
     type(spapro_center_opt_t)    :: pcenter
     type(spapro_angle_opt_t)     :: pangle
     type(axis_opt_t)             :: laxis
     type(axis_opt_t)             :: maxis
     type(option_t),      pointer :: align ! To control spectral axis alignment
     type(keywordlist_comm_t), pointer :: alignment
     type(keywordlist_comm_t), pointer :: combination
     type(cube_prod_t),        pointer :: merged   ! Not an actual product, just the merged reference header
     type(average_comm_t)         :: prod  ! Provide the actual products (average + weight)
   contains
     procedure, public  :: register     => cubemain_merging_register
     procedure, public  :: parse        => cubemain_merging_parse
  end type merging_comm_t
  !
  type merging_user_t
     type(axis_user_t)          :: faxis         ! User faxis description
     type(axis_user_t)          :: vaxis  ! User vaxis description
     type(speline_user_t)       :: line          ! Optional line name and freq
     type(spapro_type_user_t)   :: ptype         ! New projection type
     type(spapro_center_user_t) :: pcenter       ! New projection center
     type(spapro_angle_user_t)  :: pangle        ! New projection angle
     type(axis_user_t)          :: laxis         ! User laxis description
     type(axis_user_t)          :: maxis         ! User maxis description     
     type(auxiliary_user_t)     :: like
     type(identifier_user_t)    :: family
     integer(kind=code_k)       :: align  ! Alignment
     integer(kind=code_k)       :: combi  ! Combination
   contains
     procedure, public :: toprog => cubemain_merging_user_toprog
  end type merging_user_t
  !
  ! *   to be resolved at header time
  ! **  used for resampling in velocity in velociy and channel alignments
  ! *** Stored to be passed to CUBE\AVERAGE
  type merging_prog_t
     type(index_t)         :: index
     type(index_t)         :: resampled
     type(cube_t), pointer :: merged
     type(cube_t), pointer :: ref
     integer(kind=code_k)  :: align        ! Alignment
     integer(kind=4)       :: mergedid     ! Merged cube id
     !
     type(axis_user_t)          :: faxis   ! faxis description *
     type(axis_user_t)          :: vaxis   ! vaxis description *,** 
     type(speline_prog_t)       :: line    ! New line name
     type(spapro_type_user_t)   :: ptype   ! New projection type *
     type(spapro_center_user_t) :: pcenter ! New projection center *
     type(spapro_angle_user_t)  :: pangle  ! New projection angle *
     type(axis_user_t)          :: laxis   ! laxis description *
     type(axis_user_t)          :: maxis   ! maxis description *
     type(identifier_prog_t)    :: family  ! Resolved family description
     type(identifier_user_t)    :: ufamily ! User family decription ***
     logical                    :: dolike
     !
     ! Index description
     integer(kind=code_k), allocatable :: cube_kind(:)  ! Data, weight, or noise
     integer(kind=code_k)              :: aver_kind     ! Average kind to be applied
     !
     ! This is to be decided at run time
     procedure(cubemain_merging_prog_resample_like), private, pointer :: resample => null()
   contains
     procedure, private :: ref_head      => cubemain_merging_prog_ref_head
     procedure, private :: ref_head_spat => cubemain_merging_prog_ref_head_spatial
     procedure, private :: ref_head_spec => cubemain_merging_prog_ref_head_spectral
     procedure, private :: ref_head_like => cubemain_merging_prog_ref_head_like
     procedure, private :: ref_data      => cubemain_merging_prog_ref_data
     procedure, private :: ref_data_loop => cubemain_merging_prog_ref_data_loop
     procedure, private :: ref_data_act  => cubemain_merging_prog_ref_data_act
     !
     procedure, private :: analyze       => cubemain_merging_prog_analyze
     procedure, private :: reproject     => cubemain_merging_prog_reproject
     procedure, private :: average       => cubemain_merging_prog_average
     procedure, private :: loop          => cubemain_merging_prog_loop
     !
     procedure, public  :: main          => cubemain_merging_prog_main
  end type merging_prog_t
  !
contains
  !
  subroutine cubemain_merging_register(merge,adjective,ouflag,error)
    use cubetools_unit
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merging_comm_t), intent(inout) :: merge
    character(len=*),      intent(in)    :: adjective
    type(flag_t),          intent(in)    :: ouflag
    logical,               intent(inout) :: error
    !
    type(keywordlist_comm_t)  :: keyarg
    type(cube_prod_t) :: oucube
    character(len=:), allocatable :: uadjective
    character(len=*), parameter :: rname='MERGING>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    uadjective = adjective
    call sic_upper(uadjective)
    !
    call merge%family%register(&
         'Define the new family name for '//adjective//' products',&
         .not.changeflags,error)
    if (error) return
    !
    call cubemain_auxiliary_register(&
         'LIKE',&
         'Merge headers onto a template cube',&
         'Use a reference cube as template for output spatial and spectral&
         & metadata.'//strg_cr//&
         'Explicit axis/projection options (/LAXIS, /MAXIS, /FAXIS,&
         & /VAXIS, /PTYPE, /PCENTER, /PANGLE, /FREQUENCY) override values&
         & inherited from the template.',&
         merge%like,&
         'Reference cube',&
         [flag_cube],&
         code_arg_mandatory, &
         code_access_subset, &
         merge%like_arg, &
         error)
    if (error) return
    !
    call merge%freq%register(&
         'Define line name and frequency of the '//adjective//' cube',&
         error)
    if (error) return
    !
    call merge%faxis%register(&
         code_unit_freq, &
         'FAXIS',&
         'Define the frequency axis of the '//adjective//' cube',&
         error)
    if (error) return
    !
    call merge%vaxis%register(&
         code_unit_freq, &
         'VAXIS',&
         'Define the velocity axis of the '//adjective//' cube',&
         error)
    if (error) return

    !
    call merge%ptype%register(&
         'PTYPE',&
         'Define the new projection type',&
         error)
    if (error) return
    call merge%pcenter%register(&
         'PCENTER',&
         'Define the new projection center',&
         error)
    if (error) return
    call merge%pangle%register(&
         'PANGLE',&
         'Define the new projection angle',&
         error)
    if (error) return
    !
    call merge%laxis%register(&
         code_unit_fov, &
         'LAXIS',&
         'Define the L axis of the '//adjective//' cube',&
         error)
    if (error) return
    call merge%maxis%register(&
         code_unit_fov, &
         'MAXIS',&
         'Define the M axis of the '//adjective//' cube',&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'ALIGN','FREQUENCY|VELOCITY|CHANNEL',&
         'Define the spectral axis alignment',&
         'Define over which spectral axes the cubes will be aligned&
         & to produce the '//adjective//' cube. The default alignment &
         & is FREQUENCY. When the alignment is FREQUENCY option /VAXIS &
         & is ignored, When the aligment is VELOCITY option /FAXIS is&
         & ignored, and finally when the alignment is CHANNEL both &
         & /VAXIS and /FAXIS are ignored.', merge%align,error)
    if (error) return
    call keyarg%register(&
         'alignment',&
         'Alignment type',&
         strg_emp,&
         code_arg_mandatory,&
         atype,&
         .not.flexible,&
         merge%alignment,&
         error)
    if (error) return
    ! call keyarg%register(&
    !      'combination',&
    !      'combination type',&
    !      strg_id,&
    !      code_arg_optional,&
    !      ctype,&
    !      .not.flexible,&
    !      merge%combination,&
    !      error)
    ! if (error) return
    !
    ! Products
    call oucube%register(&
         uadjective,&
         adjective//' cube',&
         strg_emp,&
         [flag_merge,flag_cube],&
         merge%merged,&
         error)
    if (error) return
    call merge%prod%register(ouflag,error)
    if (error)  return
  end subroutine cubemain_merging_register
  !
  subroutine cubemain_merging_parse(merge,line,user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merging_comm_t), intent(in)    :: merge
    character(len=*),      intent(in)    :: line
    class(merging_user_t), intent(out)   :: user
    logical,               intent(inout) :: error
    !
    logical :: doalign
    character(len=argu_l) :: argu,solved
    character(len=*), parameter :: rname='MERGING>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call merge%family%parse(line,user%family,error)
    if (error) return
    call cubemain_auxiliary_parse(line,merge%like,user%like,error)
    if (error) return
    !
    ! Spectral
    call merge%faxis%parse(line,user%faxis,error)
    if (error) return
    call merge%vaxis%parse(line,user%vaxis,error)
    if (error) return
    call merge%freq%parse(line,user%line,error)
    if (error) return
    !
    ! Projection
    call merge%ptype%parse(line,user%ptype,error)
    if (error) return
    call merge%pcenter%parse(line,user%pcenter,error)
    if (error) return
    call merge%pangle%parse(line,user%pangle,error)
    if (error) return
    !
    ! Spatial axes
    call merge%laxis%parse(line,user%laxis,error)
    if (error) return
    call merge%maxis%parse(line,user%maxis,error)
    if (error) return
    !
    ! Alignment
    user%align = align_freq
    user%combi = combi_union
    call merge%align%present(line,doalign,error)
    if (error) return
    if (doalign) then
       call cubetools_getarg(line,merge%align,1,argu,mandatory,error)
       if (error) return
       call cubetools_keywordlist_user2prog(merge%alignment,argu,&
            user%align,solved,error)
       if (error) return
       ! argu = 'UNION'
       ! call cubetools_getarg(line,merge%align,2,argu,.not.mandatory,error)
       ! if (error) return
       ! call cubetools_keywordlist_user2prog(merge%combination,argu,&
       !      user%combi,solved,error)
       ! if (error) return
    endif
  end subroutine cubemain_merging_parse
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_merging_user_toprog(user,merge,prog,error)
    use cubetools_header_methods
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merging_user_t), intent(in)    :: user
    type(merging_comm_t),  intent(in)    :: merge
    type(merging_prog_t),  intent(out)   :: prog
    logical,               intent(inout) :: error
    !
    type(cube_t), pointer :: pcub
    character(len=*), parameter :: rname='MERGE>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call prog%index%get_from_current(code_access_subset,code_read_head,error)
    if (error) return
    !
    prog%dolike = user%like%do
    if (prog%dolike) then
       call cubemain_auxiliary_user2prog(merge%like_arg,user%like,prog%ref,error)
       if (error) return
    endif
    !
    ! Spectral part
    pcub => prog%index%get_cube(ione,error)
    if (error) return
    call user%line%toprog(pcub,prog%line,error)
    if (error) return
    prog%faxis = user%faxis
    prog%vaxis = user%vaxis
    !
    ! Projection part
    prog%ptype   = user%ptype
    prog%pcenter = user%pcenter
    prog%pangle  = user%pangle
    !
    ! Spatial axes
    prog%laxis = user%laxis
    prog%maxis = user%maxis
    !
    call user%family%toprog(pcub,prog%family,error)
    if (error) return
    prog%ufamily = user%family
    !
    ! Alignment
    prog%align = user%align
  end subroutine cubemain_merging_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_merging_prog_ref_head(prog,comm,error)
    use cubetools_header_methods
    use cubetools_header_types
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merging_prog_t), intent(inout) :: prog
    type(merging_comm_t),  intent(in)    :: comm
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: icub
    type(cube_t), pointer :: pcub
    character(len=*), parameter :: rname='MERGING>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    pcub => prog%index%get_cube(ione,error)
    if (error) return
    call cubeadm_clone_header(comm%merged,pcub,prog%merged,error)
    if (error) return
    !
    call prog%family%apply(prog%merged,error)
    if (error) return
    !
    if (prog%dolike) then
       call prog%ref_head_like(error)
       if (error) return
    else
       call prog%ref_head_spat(comm,error)
       if (error) return
       call prog%ref_head_spec(comm,error)
       if (error) return
    endif
    !
    do icub=1,prog%index%n
       pcub => prog%index%get_cube(icub,error)
       if (error) return
       call cubetools_header_add_observatories(pcub%head,prog%merged%head,error)
       if (error) return
    enddo
    !
    call cubemain_message(seve%r,rname,blankstr)
    call cubemain_message(seve%r,rname,'Output header:')
    call prog%merged%head%list(error)
    if (error) return
    !
  end subroutine cubemain_merging_prog_ref_head
  !
  subroutine cubemain_merging_prog_ref_head_spatial(prog,comm,error)
    use cubetools_header_methods
    use cubetools_axis_types
    use cubetopology_spatial_coordinates
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merging_prog_t), intent(inout) :: prog
    type(merging_comm_t),  intent(in)    :: comm
    logical,               intent(inout) :: error
    !
    type(axis_t) :: laxis,maxis,laxisloc,maxisloc
    real(kind=coor_k) :: absmin(2),absmax(2)
    character(len=*), parameter :: rname='MERGING>PROG>HEADER>SPATIAL'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Set up new projection
    call comm%ptype%user2prog(prog%ptype,prog%merged%head%spa%pro,error)
    if (error) return
    call comm%pcenter%user2prog(prog%merged%head%spa%fra,prog%pcenter,prog%merged%head%spa%pro,error)
    if (error) return
    call comm%pangle%user2prog(prog%pangle,prog%merged%head%spa%pro,error)
    if (error) return
    !
    !
    if (.not.(prog%laxis%do.and.prog%maxis%do)) then ! At least one axis to be guessed
       call compute_spa_region(error)
       if (error) return
    endif
    if (prog%laxis%do) then
       call cubetools_header_get_axis_head_l(prog%merged%head,laxisloc,error)
       if (error) return
       call comm%laxis%user2prog(prog%laxis,laxisloc,laxis,error)
       if (error) return
    else
       call compute_spa_axis(absmin(1),absmax(1),laxis,error)
       if (error) return
    endif
    if (prog%maxis%do) then
       call cubetools_header_get_axis_head_m(prog%merged%head,maxisloc,error)
       if (error) return
       call comm%maxis%user2prog(prog%maxis,maxisloc,maxis,error)
       if (error) return
    else
       call compute_spa_axis(absmin(2),absmax(2),maxis,error)
       if (error) return
    endif
    !
    call cubetools_header_update_axset_l(laxis,prog%merged%head,error)
    if (error) return
    call cubetools_header_update_axset_m(maxis,prog%merged%head,error)
    if (error) return
  contains
    subroutine compute_spa_axis(mini,maxi,axis,error)
      !----------------------------------------------------------------------
      ! 
      !----------------------------------------------------------------------
      real(kind=coor_k), intent(in)    :: mini
      real(kind=coor_k), intent(in)    :: maxi
      type(axis_t),      intent(inout) :: axis
      logical,           intent(inout) :: error
      !
      real(kind=coor_k) :: nrea, diff
      integer(kind=pixe_k) :: nnint
      real(kind=coor_k), parameter :: spatol = 0.1
      character(len=*), parameter :: rname='MERGING>COMPUTE>SPA>AXIS'
      !
      call cubemain_message(mainseve%trace,rname,'Welcome')
      !
      nrea  = abs((maxi-mini)/axis%inc)
      nnint = nint(nrea)
      diff = abs((nnint-nrea)*abs(axis%inc))
      if (diff.le.abs(spatol*axis%inc)) then
         axis%n = nnint
      else
         axis%n = ceiling(nrea)
      endif
      if (axis%inc.lt.0) then
         axis%ref = -(maxi-0.5*axis%inc)/axis%inc
      else
         axis%ref = (-mini+0.5*axis%inc)/axis%inc
      endif
      axis%val = 0d0
    end subroutine compute_spa_axis
    !
    subroutine compute_spa_region(error)
      !----------------------------------------------------------------------
      !
      !----------------------------------------------------------------------
      logical, intent (inout) :: error
      !
      integer(kind=4) :: iax,icub
      real(kind=coor_k) :: corners(2,4),projcorners(2,4)
      type(cube_t), pointer :: pcub
      integer(kind=8), parameter :: four=4
      !
      call cubetools_header_get_axis_head_l(prog%merged%head,laxis,error)
      if (error) return
      call cubetools_header_get_axis_head_m(prog%merged%head,maxis,error)
      if (error) return       
      call cubetopology_spatial_corners(prog%merged,corners,error)
      if (error) return
      do iax=1,2
         absmin(iax) = minval(corners(iax,:))
         absmax(iax) = maxval(corners(iax,:))
      enddo
      do icub=1,prog%index%n
         pcub => prog%index%get_cube(icub,error)
         if (error) return
         call cubetopology_spatial_corners(pcub,corners,error)
         if (error) return
         call cubetools_header_get_axis_head_l(pcub%head,laxisloc,error)
         if (error) return
         call cubetools_header_get_axis_head_m(pcub%head,maxisloc,error)
         if (error) return
         call cubetopology_spatial_reprojcoords(pcub,corners,&
              prog%merged,four,projcorners,error) 
         if (error) return
         do iax=1,2
            absmin(iax) = min(absmin(iax),minval(projcorners(iax,:)))
            absmax(iax) = max(absmax(iax),maxval(projcorners(iax,:)))
         enddo
         if (abs(laxisloc%inc).gt.abs(laxis%inc)) laxis%inc = laxisloc%inc
         if (abs(maxisloc%inc).gt.abs(maxis%inc)) maxis%inc = maxisloc%inc
      enddo
    end subroutine compute_spa_region
  end subroutine cubemain_merging_prog_ref_head_spatial
  !
  subroutine cubemain_merging_prog_ref_head_spectral(prog,comm,error)
    use cubetools_header_methods
    use cubetools_axis_types
    use cubetopology_tool
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merging_prog_t), intent(inout) :: prog
    type(merging_comm_t),  intent(in)    :: comm
    logical,               intent(inout) :: error
    !
    real(kind=coor_k) :: fmin,fmax,lfmin,lfmax,inc
    type(axis_t) :: faxis,vaxis,axisloc
    integer(kind=4) :: icub
    integer(kind=chan_k) :: nchan
    type(cube_t), pointer :: pcub
    character(len=*), parameter :: rname='MERGING>PROG>HEADER>SPECTRAL'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Set the new rest frequency
    call cubetools_header_modify_rest_frequency(prog%line%freq,prog%merged%head,error)
    if (error) return
    call cubetools_header_put_line(prog%line%name,prog%merged%head,error)
    if (error) return
    !
    select case(prog%align)
    case(align_freq)
       prog%resample => cubemain_merging_prog_resample_like
       if (prog%faxis%do) then ! User has given a desired frequency axis
          call cubetools_header_get_axis_head_f(prog%merged%head,axisloc,error)
          if (error) return
          call comm%faxis%user2prog(prog%faxis,axisloc,faxis,error)
          if (error) return
          if (faxis%val.ne.prog%line%freq) then
             call cubemain_message(seve%w,rname,'Two different rest frequencies given')
             call cubemain_message(seve%w,rname,'Using the one from the frequency axis')
          endif
       else ! No input on frequency axis from user, merge all frequency ranges
          call cubetools_header_get_axis_head_f(prog%merged%head,faxis,error)
          if (error) return
          call cubetopology_tool_fminfmax(prog%merged,fmin,fmax,error)
          if (error) return
          !
          do icub=1,prog%index%n
             pcub => prog%index%get_cube(icub,error)
             if (error) return
             call cubetopology_tool_fminfmax(pcub,lfmin,lfmax,error)
             if (error) return
             call cubetools_header_get_axis_head_f(pcub%head,axisloc,error)
             if (error) return
             fmin = min(fmin,lfmin)
             fmax = max(fmax,lfmax)
             if (abs(axisloc%inc).gt.abs(faxis%inc)) faxis%inc = axisloc%inc
          enddo ! icub
          faxis%n = ceiling((fmax-fmin)/abs(faxis%inc))
          if (faxis%inc.lt.0) then
             faxis%ref  = -(fmax-faxis%val-0.5*faxis%inc)/faxis%inc
          else
             faxis%ref  = (faxis%val-fmin+0.5*faxis%inc)/faxis%inc
          endif
       endif
       call cubetools_header_update_frequency_from_axis(faxis,prog%merged%head,error)
       if (error) return
    case(align_velo)
       prog%resample => cubemain_merging_prog_resample_vaxis
       if (prog%vaxis%do) then
          call cubetools_header_get_axis_head_v(prog%merged%head,axisloc,error)
          if (error) return
          call comm%vaxis%user2prog(prog%vaxis,axisloc,vaxis,error)
          if (error) return
       ! Second case user has not given a velocity axis, use the one
       ! with the worst velocity resolution
       else
          inc = tiny(1d0)
          do icub=1,prog%index%n
             pcub => prog%index%get_cube(1,error)
             if (error) return
             call cubetools_header_get_axis_head_v(pcub%head,axisloc,error)
             if (error) return
             if (abs(axisloc%inc).gt.abs(inc)) then
                inc = axisloc%inc
                call cubetools_axis_copy(axisloc,vaxis,error)
                if (error) return
             endif
          enddo
       endif
       call cubetools_header_update_velocity_from_axis(vaxis,prog%merged%head,error)
       if (error) return
       call axis2user(vaxis,prog%vaxis,error)
       if (error) return
    case(align_chan)
       prog%resample => cubemain_merging_prog_resample_vaxis
       ! Here we simply find the cube with the most channels and we
       ! will resample the cubes to simply add more channels at the
       ! end.
       nchan = 0
       do icub=1,prog%index%n
          pcub => prog%index%get_cube(1,error)
          if (error) return
          call cubetools_header_get_axis_head_v(pcub%head,axisloc,error)
          if (error) return
          if (axisloc%n.gt.nchan) then
             nchan = axisloc%n
          endif
       enddo
       prog%vaxis%do = .true.
       write(prog%vaxis%n,'(i0)') nchan
       prog%vaxis%ref  = strg_equal
       prog%vaxis%val  = strg_equal
       prog%vaxis%inc  = strg_equal
       prog%vaxis%unit = strg_equal
       call cubetools_header_update_velocity_from_user(prog%vaxis,prog%merged%head,error)
       if (error) return
    case default
       call cubemain_message(seve%e,rname,'Programming error code should be unreachable')
       error = .true.
       return
    end select
    !
  contains
    subroutine axis2user(axis,user,error)
      type(axis_t),      intent(in)    :: axis
      type(axis_user_t), intent(out)   :: user
      logical,           intent(inout) :: error
      !
      user%do = .true.
      write(user%n,'(i0)') axis%n
      write(user%ref,'(1PG23.16)') axis%ref
      write(user%val,'(1PG23.16)') axis%val
      write(user%inc,'(1PG23.16)') axis%inc
      user%unit = axis%unit
    end subroutine axis2user
  end subroutine cubemain_merging_prog_ref_head_spectral
  !
  subroutine cubemain_merging_prog_ref_head_like(prog,error)
    use cubetools_header_methods
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merging_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='MERGING>PROG>HEADER>LIKE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_header_spectral_like(prog%ref%head,prog%merged%head,error)
    if (error) return
    call cubetools_header_spatial_like(prog%ref%head,prog%merged%head,error)
    if (error) return
    !
    prog%resample => cubemain_merging_prog_resample_like
    !
  end subroutine cubemain_merging_prog_ref_head_like
  !
  subroutine cubemain_merging_prog_ref_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merging_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='MERGING>PROG>DATA'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! return
    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%ref_data_loop(iter,error)
       !$OMP END TASK
    enddo ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubemain_merging_prog_ref_data
  !
  subroutine cubemain_merging_prog_ref_data_loop(prog,itertask,error)
    use cubeadm_taskloop
    !----------------------------------------------------------------------
    ! The subcube iterator will be shared by all input and output subcubes
    !----------------------------------------------------------------------
    class(merging_prog_t),    intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: itertask
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='MERGING>PROG>LOOP'
    !
    do while (itertask%iterate_entry(error))
      call prog%ref_data_act(itertask,error)
      if (error) return
    enddo  ! ientry
  end subroutine cubemain_merging_prog_ref_data_loop
  !   
  subroutine cubemain_merging_prog_ref_data_act(prog,itertask,error)
    use cubetools_nan
    use cubeadm_taskloop
    use cubeadm_subcube_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merging_prog_t),    intent(inout) :: prog
    type(cubeadm_iterator_t), intent(in)    :: itertask
    logical,                  intent(inout) :: error
    !
    integer(kind=indx_k) :: ix,iy,iz
    type(subcube_t) :: ousub
    character(len=*), parameter :: rname='MERGING>PROG>ACT'
    !
    ! Subcubes are initialized here as their size (3rd dim) may change from
    ! from one subcube to another.
    call ousub%allocate('ousub',prog%merged,itertask,error)
    if (error) return
    !
    do iz=1,ousub%nz
       do iy=1,ousub%ny
          do ix=1,ousub%nx
             ousub%val(ix,iy,iz) = gr4nan
          enddo ! ix
       enddo ! iy
    enddo ! iz
    call ousub%put(error)
    if (error) return
  end subroutine cubemain_merging_prog_ref_data_act
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_merging_prog_reproject(prog,inid,error)
    use cubeadm_opened
    use cubemain_reproject
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merging_prog_t), intent(inout) :: prog
    integer(kind=4),       intent(in)    :: inid
    logical,               intent(inout) :: error
    !
    type(reproject_user_t) :: user
    character(len=16) :: writeid
    character(len=*), parameter :: rname='MERGING>PROG>REPROJECT'
    !
    write(writeid,'(i0)') inid
    call user%comm%cubeids%fill(writeid,error)
    if (error) return
    write(writeid,'(i0)') prog%mergedid
    call user%like%id%fill(writeid,error)
    if (error) return
    user%like%do    = .true.
    user%spafra%do  = .false.
    user%ptype%do   = .false.
    user%pcenter%do = .false.
    user%pangle%do  = .false.
    user%newx%do    = .false.
    user%newy%do    = .false.
    user%newx%n     = strg_star
    user%newx%ref   = strg_star
    user%newx%val   = strg_star
    user%newx%inc   = strg_star
    user%newx%unit  = strg_star
    user%newy%n     = strg_star
    user%newy%ref   = strg_star
    user%newy%val   = strg_star
    user%newy%inc   = strg_star
    user%newy%unit  = strg_star
    !
    call reproject%main(user,error)
    if (error) return
    call cubeadm_finish_all('TMP','MERGING REPROJECT',error)
    if (error) continue 
  end subroutine cubemain_merging_prog_reproject
  !
  subroutine cubemain_merging_prog_resample_like(prog,inid,error)
    use cubetools_header_methods
    use cubeadm_get
    use cubeadm_opened
    use cubemain_resample
    !----------------------------------------------------------------------
    ! Here we resample the cubes exactly like the reference cube
    !----------------------------------------------------------------------
    class(merging_prog_t), intent(inout) :: prog
    integer(kind=4),       intent(in)    :: inid
    logical,               intent(inout) :: error
    !
    type(resample_user_t) :: user
    character(len=16) :: writeid
    character(len=*), parameter :: rname='MERGING>PROG>RESAMPLE>LIKE'
    !
    write(writeid,'(i0)') inid
    call user%cubeids%fill(writeid,error)
    if (error) return
    !
    write(writeid,'(i0)') prog%mergedid
    call user%reference%id%fill(writeid,error)
    if (error) return
    user%reference%present = .true.
    user%dofreq    = .true.
    user%axis%do   = .false.
    user%axis%n    = strg_star
    user%axis%ref  = strg_star
    user%axis%val  = strg_star
    user%axis%inc  = strg_star
    user%axis%unit = strg_star
    !
    call resample%main(user,error)
    if (error) return
    call cubeadm_finish_all('TMP','MERGING RESAMPLE',error)
    if (error) return
  end subroutine cubemain_merging_prog_resample_like
  !
  subroutine cubemain_merging_prog_resample_vaxis(prog,inid,error)
    use cubetools_header_methods
    use cubeadm_get
    use cubeadm_opened
    use cubemain_resample
    !----------------------------------------------------------------------
    ! Here we resample cubes according to a pre-specified Velocity axis
    ! to warrant velocity or channel alignments
    !----------------------------------------------------------------------
    class(merging_prog_t), intent(inout) :: prog
    integer(kind=4),       intent(in)    :: inid
    logical,               intent(inout) :: error
    !
    type(resample_user_t) :: user
    character(len=16) :: writeid
    type(cube_t), pointer :: cube,merged
    character(len=*), parameter :: rname='MERGING>PROG>RESAMPLE>VAXIS'
    !
    write(writeid,'(i0)') inid
    call user%cubeids%fill(writeid,error)
    if (error) return
    !
    user%reference%present = .false.
    user%dofreq = .false.
    user%axis = prog%vaxis
    !
    call resample%main(user,error)
    if (error) return
    call cubeadm_finish_all('TMP','MERGING RESAMPLE',error)
    if (error) return
    !
    ! When not resampling like the merged cube we need to modify
    ! the header of the resampled cube so that it can have the same
    ! spectral section as the merged cube
    !
    ! VVV However this causes weird behaviours on the sizes of the
    ! output cubes and incoherences in the spectral sections
    call cubeadm_get_header(prog%mergedid,code_access_imaset,&
         code_read_head,merged,error)
    call cubeadm_get_last_cube(cube,error)
    if (error) return
    call cubetools_header_spectral_like(merged%head,cube%head,error)
    if (error) return
    call cubeadm_finish_all('TMP','MERGING SPECTRAL LIKE',error)
    if (error) continue
  end subroutine cubemain_merging_prog_resample_vaxis
  !
  subroutine cubemain_merging_prog_average(prog,comm,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merging_prog_t), intent(in)    :: prog
    type(merging_comm_t),  intent(in)    :: comm
    logical,               intent(inout) :: error
    !
    type(average_user_t) :: user
    character(len=*), parameter :: rname='MERGING>PROG>AVERAGE'
    !
    user%data_mode = code_user_index_custom
    call prog%resampled%copy(user%datind,error)
    if (error) return
    !
    user%weight_mode = prog%aver_kind
    user%family      = prog%ufamily
    !
    call comm%prod%main(user,error)
    if (error) return
  end subroutine cubemain_merging_prog_average
  !
  subroutine cubemain_merging_prog_analyze(prog,error)
    use gkernel_interfaces
    use cubedag_allflags
    !----------------------------------------------------------------------
    ! Guess which cubes are data cubes, vs weight cubes or noise cubes
    !----------------------------------------------------------------------
    class(merging_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: icub,ier,ndata,nwei,nnoi
    type(cube_t), pointer :: cube
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='MERGING>PROG>ANALYZE'
    !
    allocate(prog%cube_kind(prog%index%n),stat=ier)
    if (failed_allocate(rname,'cube kind array',ier,error)) return
    !
    ! Automatic guess based on flags. It could be made explicit with a
    ! dedicated syntax
    ndata = 0
    nwei = 0
    nnoi = 0
    do icub=1,prog%index%n
       cube => prog%index%get_cube(icub,error)
       if (error) return
       if (cube%node%flag%contains(flag_weight)) then
         nwei = nwei+1
         prog%cube_kind(icub) = kind_weight
       elseif (cube%node%flag%contains(flag_noise)) then
         nnoi = nnoi+1
         prog%cube_kind(icub) = kind_noise
       else
         ndata = ndata+1
         prog%cube_kind(icub) = kind_data
       endif
    enddo
    !
    if (nnoi.ge.1) then
      ! The rest of the code works, but we have doubt on the previous
      ! resampling and reprojection of noise cubes. Reject for now.
      call cubemain_message(seve%e,rname,'The index contains noise cubes')
      call cubemain_message(seve%e,rname,'reprojection or resampling of noise cubes is not implemented')
      error = .true.
      return
    endif
    !
    ! Minimal sanity check which we can not avoid before averaging. Note
    ! that the average engine will perform more extensive checks (and
    ! proper pairing).
    if (nwei.ge.1 .and. nnoi.ge.1) then
      write(mess,'(4(a,i0))')  &
        'Invalid mixture of ',ndata,' data cubes, ',  &
                              nwei,' weight cubes, and ',  &
                              nnoi,' noise cubes'
      call cubemain_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    if (nwei.gt.1) then
      prog%aver_kind = code_user_weight_datweiind
    elseif (nnoi.gt.1) then
      prog%aver_kind = code_user_weight_datnoiind
    else
      prog%aver_kind = code_user_weight_none
    endif
  end subroutine cubemain_merging_prog_analyze
  !
  subroutine cubemain_merging_prog_loop(prog,error)
    use cubedag_allflags
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merging_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: icub
    type(cube_t), pointer :: cube
    character(len=*), parameter :: rname='MERGING>PROG>LOOP'
    !
    do icub=1, prog%index%n
       cube => prog%index%get_cube(icub,error)
       if (error) return
       ! Data, noise, or weight cubes always resampled to the same
       ! reference.
       call prog%reproject(cube%node%id,error)
       if (error) return
       call cubeadm_get_last_cube(cube,error)
       if (error) return
       ! The reproject engine flags any cube as "reprojected,cube", which is
       ! unsatisfying:
       if (prog%cube_kind(icub).eq.kind_weight) then
        call cube%set_flags([flag_reproject,flag_weight],error)
         if (error) return
       elseif (prog%cube_kind(icub).eq.kind_noise) then
        call cube%set_flags([flag_reproject,flag_noise],error)
         if (error) return
       endif
       ! Only data cubes are resampled in spectral axis.
       if (prog%cube_kind(icub).eq.kind_data) then
         call prog%resample(cube%node%id,error)
         if (error) return
         call cubeadm_get_last_cube(cube,error)
         if (error) return
       endif
       call prog%resampled%put_cube(icub,cube,error)
       if (error) return
    enddo
  end subroutine cubemain_merging_prog_loop
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_merging_prog_main(prog,comm,error)
    use cubeadm_get
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! Routine to be called externaly to execute code
    !----------------------------------------------------------------------
    class(merging_prog_t), intent(inout) :: prog
    type(merging_comm_t),  intent(in)    :: comm
    logical,               intent(inout) :: error
    !
    type(cube_t), pointer :: cube
    character(len=*), parameter :: rname='MERGING>PROG>MAIN'
    !
    ! Produce reference cube and store its ID
    call prog%ref_head(comm,error)
    if (error) return
    call prog%ref_data(error)
    if (error) return
    call cubeadm_finish_all('TMP','MERGED REFERENCE',error)
    if (error) return
    call cubeadm_get_last_cube(cube,error)
    if (error) return
    prog%mergedid = cube%node%id
    !
    ! Analysis of the index
    call prog%analyze(error)
    if (error) return
    !
    ! Produce properly sampled cubes
    call prog%loop(error)
    if (error) return
    !
    ! Average them
    call prog%average(comm,error)
    if (error) return
  end subroutine cubemain_merging_prog_main
end module cubemain_merging
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
