!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! *** JP: Not the right coding. It should access the data per subcube instead.
! *** JP: And 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 cube_types
  use cubeadm_messaging
  use cubeadm_taskloop
  !
  public :: cubeadm_copy_data
  private
  !
  type copy_prog_t
     type(cube_t), pointer :: in
     type(cube_t), pointer :: ou
   contains
     procedure, private :: data            => cubeadm_copy_prog_data
     procedure, private :: loop            => cubeadm_copy_prog_loop
     procedure, private :: loop_image_real => cubeadm_copy_prog_loop_image_real
     procedure, private :: loop_image_cplx => cubeadm_copy_prog_loop_image_cplx
     procedure, private :: loop_spect_real => cubeadm_copy_prog_loop_spect_real
!!$     procedure, private :: loop_spect_cplx => cubeadm_copy_prog_loop_spect_cplx
  end type copy_prog_t
  !
contains
  !
  subroutine cubeadm_copy_data(in,ou,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(cube_t), target, intent(inout) :: in
    type(cube_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 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)
    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')
    !
    select case (prog%in%order())
    case (code_cube_imaset)
       if (prog%in%iscplx()) then
          call prog%loop_image_cplx(iter,error)
          if (error) return
       else
          call prog%loop_image_real(iter,error)
          if (error) return
       endif
    case (code_cube_speset)
       if (prog%in%iscplx()) then
!!$          call prog%loop_spect_cplx(iter,error)
!!$          if (error) return
          call cubeadm_message(seve%e,rname,'Copying complex spectra is not implemented')
          error = .true.
          return
       else
          call prog%loop_spect_real(iter,error)
          if (error) return
       endif
    case default
       call cubeadm_message(seve%e,rname,'Unsupported file access')
       error = .true.
       return
    end select
  end subroutine cubeadm_copy_prog_loop
  !
  subroutine cubeadm_copy_prog_loop_image_real(prog,iter,error)
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(copy_prog_t),       intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(image_t) :: image
    character(len=*), parameter :: rname='COPY>DATA>IMAGE>REAL'
    !
    call image%associate('in',prog%in,iter,error)
    if (error) return
    do while (iter%iterate_entry(error))
       call image%get(iter%ie,error)
       if (error) return
       call image%put_in(prog%ou,iter%ie,error)
       if (error) return
    enddo ! ie
  end subroutine cubeadm_copy_prog_loop_image_real
  !
  subroutine cubeadm_copy_prog_loop_image_cplx(prog,iter,error)
    use cubeadm_visi_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(copy_prog_t),       intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(visi_t) :: visi
    character(len=*), parameter :: rname='COPY>DATA>VISI>CPLX'
    !
    call visi%associate('in',prog%in,iter,error)
    if (error) return
    do while (iter%iterate_entry(error))
       call visi%get(iter%ie,error)
       if (error) return
       call visi%put_in(prog%ou,iter%ie,error)
       if (error) return
    enddo ! ie
  end subroutine cubeadm_copy_prog_loop_image_cplx
  !
  subroutine cubeadm_copy_prog_loop_spect_real(prog,iter,error)
    use cubeadm_spectrum_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(copy_prog_t),       intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(spectrum_t) :: spec
    character(len=*), parameter :: rname='COPY>DATA>SPECTRUM>REAL'
    !
    call spec%associate('in',prog%in,iter,error)
    if (error) return
    do while (iter%iterate_entry(error))
       call spec%get(iter%ie,error)
       if (error) return
       call spec%put_in(prog%ou,iter%ie,error)
       if (error) return
    enddo ! ie
  end subroutine cubeadm_copy_prog_loop_spect_real
  !
!!$  subroutine cubeadm_copy_prog_loop_spect_cplx(prog,iter,error)
!!$    use cubeadm_spectrum_cplx
!!$    !----------------------------------------------------------------------
!!$    !
!!$    !----------------------------------------------------------------------
!!$    class(copy_prog_t),       intent(inout) :: prog
!!$    type(cubeadm_iterator_t), intent(inout) :: iter
!!$    logical,                  intent(inout) :: error
!!$    !
!!$    type(spectrum_cplx_t) :: spec
!!$    character(len=*), parameter :: rname='COPY>DATA>SPECTRUM>CPLX'
!!$    !
!!$    call spec%associate('in',prog%in,error)
!!$    if (error) return
!!$    do while (iter%iterate_entry(error))
!!$       call spec%get(iter%ie,error)
!!$       if (error) return
!!$       call spec%put_in(prog%ou,iter%ie,error)
!!$       if (error) return
!!$    enddo ! ie
!!$  end subroutine cubeadm_copy_prog_loop_spect_cplx
end module cubeadm_copy_tool
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
