!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! *** JP: It should use directly the method instead of trying to select the
! *** JP: right method in the middle of the execution.
!
module cubeadm_copy_tool
  use cubetuple_format
  use cubeadm_messaging
  use cubeadm_taskloop
  !
  public :: cubeadm_copy_data
  private
  !
  type copy_prog_t
     class(format_t), pointer :: in
     class(format_t), pointer :: ou
   contains
     procedure, private :: data              => cubeadm_copy_prog_data
     procedure, private :: loop              => cubeadm_copy_prog_loop
     procedure, private :: loop_subcube_real => cubeadm_copy_prog_loop_subcube_real
     procedure, private :: loop_subcube_cplx => cubeadm_copy_prog_loop_subcube_cplx
  end type copy_prog_t
  !
contains
  !
  subroutine cubeadm_copy_data(in,ou,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(format_t), target, intent(inout) :: in
    class(format_t), target, intent(inout) :: ou
    logical,                 intent(inout) :: error
    !
    type(copy_prog_t) :: copy
    character(len=*), parameter :: rname='COPY>DATA'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    copy%in => in
    copy%ou => ou
    call copy%data(error)
    if (error) return
  end subroutine cubeadm_copy_data
  !  
  subroutine cubeadm_copy_prog_data(prog,error)
    use cubetuple_iterator
    use cubeadm_opened
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(copy_prog_t), intent(inout) :: prog
    logical,            intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='COPY>PROG>DATA'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error,align=code_align_channel)
    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 ! iter
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubeadm_copy_prog_data
  !
  subroutine cubeadm_copy_prog_loop(prog,iter,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(copy_prog_t),       intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='COPY>PROG>LOOP'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    if (prog%in%iscplx()) then
      call prog%loop_subcube_cplx(iter,error)
      if (error) return
    else
      call prog%loop_subcube_real(iter,error)
      if (error) return
    endif
  end subroutine cubeadm_copy_prog_loop
  !
  subroutine cubeadm_copy_prog_loop_subcube_real(prog,iter,error)
    use cubeadm_subcube_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(copy_prog_t),       intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(subcube_t) :: subcube
    character(len=*), parameter :: rname='COPY>DATA>SUBCUBE>REAL'
    !
    do while (iter%iterate_entry(error))
      ! Subcubes are initialized here as their size (3rd dim) may change
      ! from one subcube to another.
      call subcube%associate('in',prog%in,iter,error)
      if (error) return
      call subcube%get(error)
      if (error) return
      call subcube%put_in(prog%ou,error)
      if (error) return
    enddo ! ie
  end subroutine cubeadm_copy_prog_loop_subcube_real
  !
  subroutine cubeadm_copy_prog_loop_subcube_cplx(prog,iter,error)
    use cubeadm_subcube_cplx_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(copy_prog_t),       intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(subcube_cplx_t) :: subcube
    character(len=*), parameter :: rname='COPY>DATA>SUBCUBE>CPLX'
    !
    do while (iter%iterate_entry(error))
      ! Subcubes are initialized here as their size (3rd dim) may change
      ! from one subcube to another.
      call subcube%associate('in',prog%in,iter,error)
      if (error) return
      call subcube%get(error)
      if (error) return
      call subcube%put_in(prog%ou,error)
      if (error) return
    enddo ! ie
  end subroutine cubeadm_copy_prog_loop_subcube_cplx
end module cubeadm_copy_tool
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
