!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_shuffle
  use cube_types
  use cubetools_structure
  use cubeadm_cubeid_types
  use cubeadm_cubeprod_types
  use cubetopology_cuberegion_types
  use cubemain_messaging
  !
  public :: shuffle
  public :: cubemain_shuffle_command
  private
  !
  type :: shuffle_comm_t
     type(option_t), pointer :: comm
     type(cuberegion_comm_t) :: region
     type(cubeid_arg_t), pointer :: cube
     type(cubeid_arg_t), pointer :: centroid
     type(cube_prod_t),  pointer :: shuffled
   contains
     procedure, public  :: register => cubemain_shuffle_comm_register
     procedure, private :: parse    => cubemain_shuffle_comm_parse
     procedure, private :: main     => cubemain_shuffle_comm_main
  end type shuffle_comm_t
  type(shuffle_comm_t) :: shuffle
  !
  type shuffle_user_t
     type(cubeid_user_t)     :: cubeids
     type(cuberegion_user_t) :: region
   contains
     procedure, private :: toprog => cubemain_shuffle_user_toprog
  end type shuffle_user_t
  !
  type shuffle_prog_t
     type(cuberegion_prog_t) :: region
     type(cube_t), pointer   :: cube
     type(cube_t), pointer   :: shuffled
     type(cube_t), pointer   :: centroid
     real(kind=coor_k)       :: vmin     ! [kms] velocity axis minimum
     real(kind=coor_k)       :: vmax     ! [kms] velocity axis maximum
     integer(kind=chan_k)    :: nc       ! [---] Number of channels
   contains
     procedure, private :: header => cubemain_shuffle_prog_header
     procedure, private :: data   => cubemain_shuffle_prog_data
     procedure, private :: loop   => cubemain_shuffle_prog_loop
     procedure, private :: act    => cubemain_shuffle_prog_act
  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_comm_register(comm,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(shuffle_comm_t), intent(inout) :: comm
    logical,               intent(inout) :: error
    !
    type(cubeid_arg_t) :: incube
    type(cube_prod_t) :: oucube
    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>COMM>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Syntax
    call cubetools_register_command(&
         'SHUFFLE','[cubeid [velocityid]]',&
         comm_abstract,&
         comm_help,&
         cubemain_shuffle_command,&
         comm%comm,&
         error)
    if (error) return
    call incube%register(&
         'CUBE',&
         'Signal cube',&
         strg_id,&
         code_arg_optional,&
         [flag_cube],&
         code_read,&
         code_access_speset,&
         comm%cube,&
         error)
    if (error) return
    call incube%register(&
         'CENTROID',&
         'Centroid image',&
         strg_id,&
         code_arg_optional,&
         [flag_moment,flag_peak,flag_velocity,flag_signal],&
         code_read,&
         code_access_speset,&
         comm%centroid,&         
         error)
    if (error) return
    call comm%region%register(error)
    if (error) return
    !
    ! Products
    call oucube%register(&
         'SHUFFLED',&
         'Shuffled cube',&
         strg_id,&
         [flag_shuffled,flag_cube],&
         comm%shuffled,&
         error)
    if (error) return
  end subroutine cubemain_shuffle_comm_register
  !
  subroutine cubemain_shuffle_comm_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(shuffle_comm_t), intent(in)    :: comm
    character(len=*),      intent(in)    :: line
    type(shuffle_user_t),  intent(out)   :: user
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='SHUFFLE>COMM>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,comm%comm,user%cubeids,error)
    if (error) return
    call comm%region%parse(line,user%region,error)
    if (error) return
  end subroutine cubemain_shuffle_comm_parse
  !
  subroutine cubemain_shuffle_comm_main(comm,user,error)
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(shuffle_comm_t), intent(in)    :: comm
    type(shuffle_user_t),  intent(in)    :: user
    logical,               intent(inout) :: error
    !
    type(shuffle_prog_t) :: prog
    character(len=*), parameter :: rname='SHUFFLE>COMM>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(comm,prog,error)
    if (error) return
    call prog%header(comm,error)
    if (error) return
    call cubeadm_timing_prepro2process()
    call prog%data(error)
    if (error) return
    call cubeadm_timing_process2postpro()
  end subroutine cubemain_shuffle_comm_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_shuffle_user_toprog(user,comm,prog,error)
    use cubetools_consistency_methods
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(shuffle_user_t), intent(in)    :: user
    type(shuffle_comm_t),  intent(in)    :: comm
    type(shuffle_prog_t),  intent(out)   :: prog
    logical,               intent(inout) :: error
    !
    logical :: conspb
    character(len=*), parameter :: rname='SHUFFLE>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_get_header(comm%cube,user%cubeids,prog%cube,error)
    if (error) return
    call cubeadm_cubeid_get_header(comm%centroid,user%cubeids,prog%centroid,error)
    if (error) return
    conspb = .false.
    call cubetools_consistency_spatial('Input cube',prog%cube%head,'Centroid',prog%centroid%head,conspb,error)
    if (error) return
    if (cubetools_consistency_failed(rname,conspb,error)) return
    !
    call user%region%toprog(prog%cube,prog%region,error)
    if (error) return
    ! User feedback about the interpretation of his command line
    call prog%region%list(error)
    if (error) return    
  end subroutine cubemain_shuffle_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_shuffle_prog_header(prog,comm,error)
    use cubetools_axis_types
    use cubetools_header_methods
    use cubedag_allflags
    use cubeadm_clone
    use cubetemplate_topology
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(shuffle_prog_t), intent(inout) :: prog
    type(shuffle_comm_t),  intent(in)    :: comm
    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(comm%shuffled,prog%cube,prog%shuffled,error)
    if (error) return
    call prog%region%header(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 cubetemplate_topo_vminvmax(prog%cube,prog%vmin,prog%vmax,error)
    if (error) return
    call cubetools_header_get_nchan(prog%shuffled%head,prog%nc,error)
    if (error) return
  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,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_shuffle_prog_data
  !
  subroutine cubemain_shuffle_prog_loop(prog,iter,error)
    use cubeadm_taskloop
    use cubeadm_spectrum_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(shuffle_prog_t),    intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(spectrum_t) :: inspe,centroid,shuffled
    character(len=*), parameter :: rname='SHUFFLE>PROG>LOOP'
    !
    call inspe%associate('input',prog%cube,iter,error)
    if (error) return
    call centroid%allocate('centroid',prog%centroid,iter,error)
    if (error) return
    call shuffled%allocate('shuffled',prog%shuffled,iter,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
      call prog%act(iter%ie,inspe,centroid,shuffled,error)
      if (error) return
    enddo ! ie
  end subroutine cubemain_shuffle_prog_loop
  !
  subroutine cubemain_shuffle_prog_act(prog,ie,inspe,centroid,shuffled,error)
    use cubetools_nan
    use cubetemplate_topology
    use cubeadm_spectrum_types
    !----------------------------------------------------------------------
    !
    ! 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) :: inspe
    type(spectrum_t),      intent(inout) :: centroid
    type(spectrum_t),      intent(inout) :: shuffled
    logical,               intent(inout) :: error
    !
    real(kind=8), parameter :: tole=1e-6 ! ***JP: Why this choice?
    integer(kind=chan_k), parameter :: one=1
    integer(kind=chan_k) :: ic,iright,ileft,ishift
    real(kind=coor_k) :: vcen,icen,rfrac,lfrac,shift
    character(len=*), parameter :: rname='SHUFFLE>PROG>ACT'
    !
    call inspe%get(ie,error)
    if (error) return
    call centroid%get(ie,error)
    if (error) return
    vcen = centroid%y%val(one)
    if (.not.ieee_is_nan(vcen).and.((prog%vmin.lt.vcen).and.(vcen.lt.prog%vmax))) then
       call cubetemplate_topo_velocity2rchannel(prog%cube,vcen,icen,error)
       if (error) return
       if (abs(icen-nint(icen)).lt.tole) then
          ! This is a permutation by an integer number of channels
          ishift = nint(icen-prog%shuffled%head%spe%ref%c)
          shuffled%y%val(:) = cshift(inspe%y%val(:),ishift)
       else
          ! Needs to resample.  This code is very similar to the resampling
          ! one as 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.
          rfrac = ceiling(icen)-icen
          lfrac = icen-floor(icen)
          shift = icen-prog%cube%head%spe%ref%c
          do ic=1,prog%nc
             iright = nint(ic-shift)
             ileft  = iright-1
             if (ileft.le.0) ileft = ileft+prog%nc
             if (iright.le.0) iright = iright+prog%nc
             if (ileft.gt.prog%nc) ileft = ileft-prog%nc
             if (iright.gt.prog%nc) iright = iright-prog%nc
             shuffled%y%val(ic) = inspe%y%val(ileft)*lfrac+inspe%y%val(iright)*rfrac
          enddo ! ic
       endif
    else
       ! ***JP: This one is ambiguous. On one hand, keeping the spectrum
       ! ***JP: as it was avoids putting too much NaN. On the other hand,
       ! ***JP: this leaves the spectrum unshuffled without warning the
       ! ***JP: user. This can mess up following operations.
       shuffled%y%val(:) = inspe%y%val(:)
       ! shuffled%t(:) = gr4_nan
    endif
    call shuffled%put(ie,error)
    if (error) return
  end subroutine cubemain_shuffle_prog_act
end module cubemain_shuffle
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
