!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_shuffle
  use cubetools_structure
  use cube_types
  use cubeadm_cubeid_types
  use cubemain_messaging
  !
  public :: shuffle
  public :: cubemain_shuffle_command
  private
  !
  type :: shuffle_comm_t
     type(option_t), pointer :: comm
   contains
     procedure, public  :: register => cubemain_shuffle_register
     procedure, private :: parse    => cubemain_shuffle_parse
     procedure, private :: main     => cubemain_shuffle_main
  end type shuffle_comm_t
  type(shuffle_comm_t) :: shuffle
  !
  integer(kind=4), parameter :: icube = 1
  integer(kind=4), parameter :: icent = 2
  type shuffle_user_t
     type(cubeid_user_t)   :: cubeids
   contains
     procedure, private :: toprog => cubemain_shuffle_user_toprog
  end type shuffle_user_t
  !
  type shuffle_prog_t
     type(cube_t), pointer :: cube     ! Input cube
     type(cube_t), pointer :: shuffled ! Output cube
     type(cube_t), pointer :: centroid ! Centroid cube
     real(kind=coor_k)     :: vmin     ! [kms] velocity axis minimum
     real(kind=coor_k)     :: vmax     ! [kms] velocity axis maximum
     integer(kind=chan_k)  :: refc     ! [---] Reference channel
   contains
     procedure, private :: header   => cubemain_shuffle_prog_header
     procedure, private :: data     => cubemain_shuffle_prog_data
     procedure, private :: loop     => cubemain_shuffle_prog_loop
     procedure, private :: spectrum => cubemain_shuffle_prog_spectrum
  end type shuffle_prog_t
  !
contains
  !
  subroutine cubemain_shuffle_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(shuffle_user_t) :: user
    character(len=*), parameter :: rname='SHUFFLE>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    call shuffle%parse(line,user,error)
    if (error) return
    call shuffle%main(user,error)
    if (error) continue
  end subroutine cubemain_shuffle_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_shuffle_register(shuffle,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(shuffle_comm_t), intent(inout) :: shuffle
    logical,               intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    character(len=*), parameter :: comm_abstract = &
         'Shuffle the spectral axis of a cube'
    character(len=*), parameter :: comm_help = &
         'Circularly shift each spectrum by a user defined velocity given &
         &as an image of velocities. A linear interpolation of the channels &
         &is done when required. This enables the user to, e.g., remove &
         &systematic velocity gradients before stacking spectra. By default, &
         &the command will search for the peak velocity images computed by the &
         &MOMENT command.'
    character(len=*), parameter :: rname='SHUFFLE>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'SHUFFLE','[cubeid [veloid]]',&
         comm_abstract,&
         comm_help,&
         cubemain_shuffle_command,&
         shuffle%comm,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         'Signal cube',  &
         strg_id,&
         code_arg_optional,  &
         [flag_cube], &
         error)
    if (error) return
    call cubearg%register( &
         'VELOCITY', &
         'Velocity image',  &
         strg_id,&
         code_arg_optional,  &
         [flag_moment,flag_peak,flag_velocity,flag_signal], &
         error)
    if (error) return
  end subroutine cubemain_shuffle_register
  !
  subroutine cubemain_shuffle_parse(shuffle,line,user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(shuffle_comm_t), intent(in)    :: shuffle
    character(len=*),      intent(in)    :: line
    type(shuffle_user_t),  intent(out)   :: user
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='SHUFFLE>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,shuffle%comm,user%cubeids,error)
    if (error) return
  end subroutine cubemain_shuffle_parse
  !
  subroutine cubemain_shuffle_main(shuffle,user,error)
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(shuffle_comm_t), intent(in)    :: shuffle
    type(shuffle_user_t),  intent(in)    :: user
    logical,               intent(inout) :: error
    !
    type(shuffle_prog_t) :: prog
    character(len=*), parameter :: rname='SHUFFLE>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_shuffle_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_shuffle_user_toprog(user,prog,error)
    use cubetools_consistency_methods
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(shuffle_user_t), intent(in)    :: user
    type(shuffle_prog_t),  intent(out)   :: prog
    logical,               intent(inout) :: error
    !
    logical :: prob
    character(len=*), parameter :: rname='SHUFFLE>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_get_header(shuffle%comm,icube,user%cubeids,code_access_speset,&
         code_read,prog%cube,error)
    if (error) return
    call cubeadm_cubeid_get_header(shuffle%comm,icent,user%cubeids,code_access_speset,&
         code_read,prog%centroid,error)
    if (error) return
    !
    prob = .false.
    call cubetools_consistency_spatial('Input cube',prog%cube%head,'Centroid',prog%centroid%head,prob,error)
    if (error) return
    if (cubetools_consistency_failed(rname,prob,error)) return
  end subroutine cubemain_shuffle_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_shuffle_prog_header(prog,error)
    use cubetools_axis_types
    use cubetools_header_methods
    use cubedag_allflags
    use cubeadm_clone
    use cubemain_topology
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(shuffle_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    type(axis_t) :: axis
    character(len=*), parameter :: rname='SHUFFLE>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(prog%cube,[flag_shuffle,flag_cube],prog%shuffled,error)
    if (error) return
    !
    ! Move reference channel to the central one
    call cubetools_header_get_axis_head_c(prog%shuffled%head,axis,error)
    if (error) return
    ! *** JP This lines enables us to state that the cube has been shuffled
    ! *** JP but it also messes up the export/import mechanism as the cube
    ! *** JP can not be reimported afterwards because the velocity axis is
    ! *** JP not recognized anymore => Commented out for the moment.
!   axis%name = 'Shuffled '//axis%name
    ! *** JP
    axis%ref = nint(0.5*axis%n) ! *** JP Should it be a nint?
    call cubetools_header_update_axset_c(axis,prog%shuffled%head,error)
    if (error) return
    !
    call cubemain_topo_vminvmax(prog%cube,prog%vmin,prog%vmax,error)
    if(error) return
    !
    prog%refc = nint(prog%shuffled%head%spe%ref%c,kind=chan_k)
    !
  end subroutine cubemain_shuffle_prog_header
  !
  subroutine cubemain_shuffle_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(shuffle_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='SHUFFLE>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) FIRSTPRIVATE(iter,error)
       if (.not.error)  &
         call prog%loop(iter%first,iter%last,error)
       !$OMP END TASK
    enddo ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubemain_shuffle_prog_data
  !
  subroutine cubemain_shuffle_prog_loop(prog,first,last,error)
    use cubemain_spectrum_real
    use cubeadm_entryloop
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(shuffle_prog_t), intent(inout) :: prog
    integer(kind=entr_k),  intent(in)    :: first
    integer(kind=entr_k),  intent(in)    :: last
    logical,               intent(inout) :: error
    !
    integer(kind=entr_k) :: ie
    integer(kind=chan_k),parameter :: one =1
    type(spectrum_t) :: inspec,cent,ouspec
    character(len=*), parameter :: rname='SHUFFLE>PROG>LOOP'
    !
    call inspec%reassociate_and_init(prog%cube,error)
    if (error) return
    call cent%reallocate('centroid',one,error)
    if (error) return
    call ouspec%reallocate('shuffled',prog%shuffled%head%spe%c%n,error)
    if (error) return
    !
    do ie=first,last
      call cubeadm_entryloop_iterate(ie,error)
      if (error)  return
      call prog%spectrum(ie,inspec,cent,ouspec,error)
      if (error)  return
    enddo
  end subroutine cubemain_shuffle_prog_loop
  !
  subroutine cubemain_shuffle_prog_spectrum(prog,ie,inspec,centro,ouspec,error)
    use cubetools_nan
    use cubemain_spectrum_real
    use cubemain_topology
    !----------------------------------------------------------------------
    ! This code is very similar to
    ! cubemain_spectrum_resample_2under/over in that it is a 2 point
    ! interpolation, it is however different because there is no
    ! change in channel size and there is a permutation at the edges
    ! of the spectral ranges.
    !
    ! Contamination: Currently the output is corrupted by blanks if
    ! there are any in the output, which is also the behaviour in
    ! cube\resample.
    ! ----------------------------------------------------------------------
    class(shuffle_prog_t), intent(inout) :: prog
    integer(kind=entr_k),  intent(in)    :: ie
    type(spectrum_t),      intent(inout) :: inspec
    type(spectrum_t),      intent(inout) :: centro
    type(spectrum_t),      intent(inout) :: ouspec
    logical,               intent(inout) :: error
    !
    integer(kind=chan_k) :: ic,iright,ileft,ishift
    real(kind=coor_k) :: vcen,icen,rfrac,lfrac,shift
    real(kind=8), parameter :: tole = 1e-6
    character(len=*), parameter :: rname='SHUFFLE>PROG>SPECTRUM'
    !
    call inspec%get(prog%cube,ie,error)
    if (error)  return
    call centro%get(prog%centroid,ie,error)
    if (error)  return
    vcen = centro%t(1)
    if (.not.ieee_is_nan(vcen).and.((prog%vmin.lt.vcen).and.(vcen.lt.prog%vmax))) then
       call cubemain_topo_velocity2rchannel(prog%cube,vcen,icen,error)
       if (error) return
       ! This is a permutation by an integer number of channels
       if (abs(icen-nint(icen)).lt.tole) then ! 
          ishift = nint(icen-prog%shuffled%head%spe%ref%c)
          ouspec%t(:) = cshift(inspec%t(:),ishift)
       else
          rfrac = ceiling(icen)-icen
          lfrac = icen-floor(icen)
          shift = icen-prog%cube%head%spe%ref%c
          do ic=1,prog%shuffled%head%arr%n%c
             iright = nint(ic-shift)
             ileft  = iright-1
             if (ileft.le.0) ileft = ileft+prog%cube%head%arr%n%c
             if (iright.le.0) iright = iright+prog%cube%head%arr%n%c
             if (ileft.gt.prog%cube%head%arr%n%c) ileft = ileft-prog%cube%head%arr%n%c
             if (iright.gt.prog%cube%head%arr%n%c) iright = iright-prog%cube%head%arr%n%c
             ouspec%t(ic) = inspec%t(ileft)*lfrac+inspec%t(iright)*rfrac
          enddo
       endif
    else
       ouspec%t(:) = inspec%t(:)
    endif
    call ouspec%put(prog%shuffled,ie,error)
    if (error)  return
  end subroutine cubemain_shuffle_prog_spectrum
end module cubemain_shuffle
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
