!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_merge
  use cubetools_structure
  use cubetools_axis_types
  use cubetools_spapro_types
  use cube_types
  use cubemain_messaging
  use cubemain_auxiliary
  use cubemain_speline_types
  !
  public :: merge,cubemain_merge_command
  private
  !
  type merge_comm_t
     type(option_t), pointer   :: comm
     type(option_t), pointer   :: family
     type(option_t), pointer   :: like
     type(axis_opt_t)          :: faxis
     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
   contains
     procedure, public  :: register     => cubemain_merge_register
     procedure, private :: parse        => cubemain_merge_parse
     procedure, private :: parse_family => cubemain_merge_parse_family
     procedure, private :: main         => cubemain_merge_main
  end type merge_comm_t
  type(merge_comm_t) :: merge
  !
  integer(kind=4), parameter :: ione = 1 
  type merge_user_t
     type(axis_user_t)          :: faxis         ! User faxis description
     type(speline_user_t)       :: line          ! Optional new 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 
     character(len=base_l)      :: family
     logical                    :: dofamily
   contains
     procedure, private :: toprog => cubemain_merge_user_toprog
  end type merge_user_t
  !
  type cube_p_t
     type(cube_t), pointer :: p
  end type cube_p_t
  !
  type merge_prog_t
     integer(kind=4)             :: n
     type(cube_p_t), allocatable :: cubes(:)
     type(cube_t), pointer :: merged
     type(cube_t), pointer :: ref
     !
     type(axis_user_t)          :: faxis      ! User faxis description, to be resolved at header time
     type(speline_prog_t)       :: line
     type(spapro_type_user_t)   :: ptype      ! New projection type, to be resolved at header time
     type(spapro_center_user_t) :: pcenter    ! New projection center, to be resolved at header time
     type(spapro_angle_user_t)  :: pangle     ! New projection angle, to be resolved at header time
     type(axis_user_t)          :: laxis      ! User laxis description, to be resolved at header time
     type(axis_user_t)          :: maxis      ! User maxis description, to be resolved at header time
     character(len=base_l) :: family
     logical               :: dofamily
     logical               :: dolike
   contains
     procedure, private :: header          => cubemain_merge_prog_header
     procedure, private :: header_spatial  => cubemain_merge_prog_header_spatial
     procedure, private :: header_spectral => cubemain_merge_prog_header_spectral
     procedure, private :: header_like     => cubemain_merge_prog_header_like
     procedure, private :: data            => cubemain_merge_prog_data
     procedure, private :: loop            => cubemain_merge_prog_loop
     procedure, private :: act             => cubemain_merge_prog_act
  end type merge_prog_t
  !
contains
  !
  subroutine cubemain_merge_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(merge_user_t) :: user
    character(len=*), parameter :: rname = 'MERGE>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call merge%parse(line,user,error)
    if (error) return
    !
    call merge%main(user,error)
    if (error) return
  end subroutine cubemain_merge_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_merge_register(merge,error)
    use cubetools_unit
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merge_comm_t), intent(inout) :: merge
    logical,             intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: rname = 'MERGE>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'MERGE','cube1 cube2',&
         'Merge headers from the current index',&
         'Merge the headers of the cubes in the current index in an&
         & output header. Several aspects of this output header can&
         & be controlled: its axes (/LAXIS, /MAXIS and /FAXIS), its&
         & projection (/PTYPE, /PCENTER and /PANGLE) as well as its&
         & reference frequency and line. A reference can be used to&
         & define the spectral and spatial characteristics of the&
         & merged header (/LIKE). If no options are given the axes&
         & will be chosen in a way to cover all the data in all cubes&
         & in the index. By default the family name of the output&
         & cube will be the same of the first cube in the current&
         & index, this can be changed with the usage of option /FAMILY.',&
         cubemain_merge_command, merge%comm,error)
    if (error) return
    !
    call cubetools_register_option(&
         'FAMILY','newfamily',&
         'Define the new family name for products',&
         strg_id,&
         merge%family,error)
    if (error) return
    call stdarg%register(&
         'newfamily',&
         'New family name for products',&
         strg_id,&
         code_arg_mandatory,&
         error)
    if (error) return
    !
    call cubemain_auxiliary_register(&
         'LIKE',&
         'Merge headers onto a template cube',&
         strg_id,&
         'Reference cube',&
         [flag_cube],&
         code_arg_mandatory, &
         merge%like,error)
    if (error) return
    !
    call merge%freq%register(&
         'Define line name and frequency of the merged cube',&
         error)
    if (error) return
    !
    call merge%faxis%register(&
         code_unit_freq, &
         'FAXIS',&
         'Define the frequency axis of the merged 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 merged cube',&
         error)
    if (error) return
    call merge%maxis%register(&
         code_unit_fov, &
         'MAXIS',&
         'Define the M axis of the merged cube',&
         error)
    if (error) return
  end subroutine cubemain_merge_register
  !
  subroutine cubemain_merge_parse(merge,line,user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merge_comm_t), intent(in)    :: merge
    character(len=*),    intent(in)    :: line
    type(merge_user_t),  intent(out)   :: user
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname = 'MERGE>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call merge%parse_family(line,user,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%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
  end subroutine cubemain_merge_parse
  !
  subroutine cubemain_merge_parse_family(merge,line,user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merge_comm_t), intent(in)    :: merge 
    character(len=*),      intent(in)    :: line
    type(merge_user_t),  intent(inout) :: user
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='MERGE>PARSE>FAMILY'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call merge%family%present(line,user%dofamily,error)
    if (error) return
    if (user%dofamily) then
       call cubetools_getarg(line,merge%family,1,user%family,mandatory,error)
       if (error) return
    else
       ! Do nothing
    endif
  end subroutine cubemain_merge_parse_family
  !
  subroutine cubemain_merge_main(merge,user,error)
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merge_comm_t), intent(in)    :: merge
    type(merge_user_t),  intent(in)    :: user
    logical,             intent(inout) :: error
    !
    type(merge_prog_t) :: prog
    character(len=*), parameter :: rname = 'MERGE>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(prog,error)
    if (error) return
    call prog%header(error)
    if (error) return
    call cubeadm_timing_prepro2process()
    call prog%data(error)
    if (error) return
    call cubeadm_timing_process2postpro()
  end subroutine cubemain_merge_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_merge_user_toprog(user,prog,error)
    use gkernel_interfaces
    use cubedag_types
    use cubedag_find
    use cubeadm_get
    use cubetools_header_methods
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merge_user_t), intent(in)    :: user
    type(merge_prog_t),  intent(out)   :: prog
    logical,             intent(inout) :: error
    !
    integer(kind=entr_k) :: icub
    type(cubedag_find_t) :: find
    type(cubedag_optimize_t) :: mycx
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='MERGE>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! 'find' unmodified => find everything
    call cubedag_find_cx2optx(find,mycx,error)
    if (error)  return
    prog%n = mycx%next-1
    !
    ! Build cube list
    allocate(prog%cubes(prog%n),stat=ier)
    if (failed_allocate(rname,'Cube list',ier,error)) return
    do icub=1,prog%n
       call cubeadm_get_header(mycx%object(icub)%p%node%id,code_access_subset,code_read_head,&
            prog%cubes(icub)%p,error)
    enddo
    !
    prog%dolike = user%like%do
    if (prog%dolike) then
       call cubemain_auxiliary_user2prog(merge%like,code_access_subset,&
            user%like,prog%ref,error)
       if (error) return
    endif
    !
    ! Spectral part
    call user%line%toprog(prog%cubes(ione)%p,prog%line,error)
    if (error) return
    prog%faxis = user%faxis
    !
    ! Projection part
    prog%ptype   = user%ptype
    prog%pcenter = user%pcenter
    prog%pangle  = user%pangle
    !
    ! Spatial axes
    prog%laxis = user%laxis
    prog%maxis = user%maxis
    !
    prog%dofamily = user%dofamily
    prog%family   = user%family
  end subroutine cubemain_merge_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_merge_prog_header(prog,error)
    use cubetools_header_methods
    use cubetools_header_types
    use cubedag_allflags 
    use cubedag_node
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merge_prog_t), intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    integer(kind=4) :: icub
    character(len=*), parameter :: rname='MERGE>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(prog%cubes(ione)%p,[flag_merge,flag_cube],prog%merged,error)
    if (error) return
    !
    if (prog%dofamily) then
       call cubedag_node_set_family(prog%merged,prog%family,error)
       if (error)  return
    endif
    !
    if (prog%dolike) then
       call prog%header_like(error)
       if (error) return
    else
       call prog%header_spatial(error)
       if (error) return
       call prog%header_spectral(error)
       if (error) return
    endif
    !
    do icub=1,prog%n
       call cubetools_header_add_observatories(prog%cubes(icub)%p%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_merge_prog_header
  !
  subroutine cubemain_merge_prog_header_spatial(prog,error)
    use cubetools_header_methods
    use cubetools_axis_types
    use cubemain_spatial_coordinates
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merge_prog_t), intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    type(axis_t) :: laxis,maxis,laxisloc,maxisloc
    real(kind=coor_k) :: absmin(2),absmax(2)
    character(len=*), parameter :: rname='MERGE>PROG>HEADER>SPATIAL'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Set up new projection
    call merge%ptype%user2prog(prog%ptype,prog%merged%head%spa%pro,error)
    if (error) return
    call merge%pcenter%user2prog(prog%merged%head%spa%fra,prog%pcenter,prog%merged%head%spa%pro,error)
    if (error) return
    call merge%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 merge%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 merge%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='MERGE>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)
      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 cubemain_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%n
         call cubemain_spatial_corners(prog%cubes(icub)%p,corners,error)
         if (error) return
         call cubetools_header_get_axis_head_l(prog%cubes(icub)%p%head,laxisloc,error)
         if (error) return
         call cubetools_header_get_axis_head_m(prog%cubes(icub)%p%head,maxisloc,error)
         if (error) return
         call cubemain_spatial_reprojcoords(prog%cubes(icub)%p,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_merge_prog_header_spatial
  !
  subroutine cubemain_merge_prog_header_spectral(prog,error)
    use cubetools_header_methods
    use cubetools_axis_types
    use cubemain_topology
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merge_prog_t), intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    real(kind=coor_k) :: fmin,fmax,lfmin,lfmax
    type(axis_t) :: faxis,faxisloc
    integer(kind=4) :: icub
    character(len=*), parameter :: rname='MERGE>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
    !
    if (prog%faxis%do) then ! User has given a desired frequency axis
       call cubetools_header_get_axis_head_f(prog%merged%head,faxisloc,error)
       if (error) return
       call merge%faxis%user2prog(prog%faxis,faxisloc,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 cubemain_topo_fminfmax(prog%merged,fmin,fmax,error)
       if (error) return
       !
       do icub=1,prog%n
          call cubemain_topo_fminfmax(prog%cubes(icub)%p,lfmin,lfmax,error)
          if (error) return
          call cubetools_header_get_axis_head_f(prog%cubes(icub)%p%head,faxisloc,error)
          if (error) return
          fmin = min(fmin,lfmin)
          fmax = max(fmax,lfmax)
          if (abs(faxisloc%inc).gt.abs(faxis%inc)) faxis%inc = faxisloc%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
  end subroutine cubemain_merge_prog_header_spectral
  !
  subroutine cubemain_merge_prog_header_like(prog,error)
    use cubetools_header_methods
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merge_prog_t), intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='MERGE>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
    !
  end subroutine cubemain_merge_prog_header_like
  !
  subroutine cubemain_merge_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merge_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='MERGE>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) FIRSTPRIVATE(iter,error)
       if (.not.error) &
          call prog%loop(iter,error)
       !$OMP END TASK
    enddo ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubemain_merge_prog_data
  !
  subroutine cubemain_merge_prog_loop(prog,taskiter,error)
    use cubeadm_entryloop
    use cubeadm_taskloop
    use cubeadm_subcube_types
    !----------------------------------------------------------------------
    ! The subcube iterator will be shared by all input and output subcubes
    !----------------------------------------------------------------------
    class(merge_prog_t),    intent(inout) :: prog
    type(cubeadm_iterator_t), intent(in)    :: taskiter
    logical,                  intent(inout) :: error
    !
    integer(kind=entr_k) :: isubcube
    type(subcube_iterator_t) :: subiter
    character(len=*), parameter :: rname='MERGE>PROG>LOOP'
    !
    do isubcube=taskiter%first,taskiter%last
      call cubeadm_entryloop_iterate(isubcube,error)
      if (error) return
      call subiter%iterate(taskiter,isubcube,error)
      if (error) return
      call prog%act(subiter,error)
      if (error) return
    enddo ! isubcube
  end subroutine cubemain_merge_prog_loop
  !   
  subroutine cubemain_merge_prog_act(prog,subiter,error)
    use cubetools_nan
    use cubeadm_subcube_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(merge_prog_t),      intent(inout) :: prog
    type(subcube_iterator_t), intent(in)    :: subiter
    logical,                  intent(inout) :: error
    !
    integer(kind=indx_k) :: ix,iy,iz
    type(subcube_t) :: ousub
    character(len=*), parameter :: rname='MERGE>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,subiter,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_merge_prog_act
end module cubemain_merge
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
