module cubeio_transpose
  use cubetools_setup_types
  use cubedag_node_type
  use cubeio_messaging
  use cubeio_cube_define
  use cubeio_cube
  use cubeio_desc
  use cubeio_desc_setup
  use cubeio_chan
  use cubeio_pix
  use cubeio_subcube
  use cubeio_highlevel

  public :: cubeio_transpose_cube_desc
  public :: cubeio_transpose_memory,cubeio_transpose_disk
  private

contains

  subroutine cubeio_transpose_cube_desc(cubset,cubdef,in,out,error)
    !---------------------------------------------------------------------
    ! Memory-to-memory transposition of the input 'cubeio_cube_t' into the
    ! output one
    !---------------------------------------------------------------------
    type(cube_setup_t),   intent(in)    :: cubset
    type(cube_define_t),  intent(in)    :: cubdef
    type(cubeio_cube_t),  intent(in)    :: in
    type(cubeio_cube_t),  intent(inout) :: out
    logical,              intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='TRANSPOSE>CUBE>DESC'
    !
    if (.not.cubdef%dotransname) then
      call cubeio_message(seve%e,rname,'Transposed cube name is not set')
      error = .true.
      return
    endif
    call cubeio_desc_transpose(in%desc,out%desc,cubdef%access,error)
    if (error) return
    out%file%name = cubdef%transname
    call cubeio_set_descriptor_external(cubset,cubdef,.true.,out,error)
    if (error)  return
  end subroutine cubeio_transpose_cube_desc
  !
  subroutine cubeio_transpose_memory(cubset,cubdef,  &
    dno,cubin,cubout,error)
    use cubetools_terminal_tool
    !-------------------------------------------------------------------
    ! Perform the transposition from input cube in memory to output cube
    ! in memory.
    !-------------------------------------------------------------------
    type(cube_setup_t),           intent(in)    :: cubset
    type(cube_define_t),          intent(in)    :: cubdef
    class(cubedag_node_object_t), intent(inout) :: dno
    type(cubeio_cube_t),          intent(inout) :: cubin
    type(cubeio_cube_t),          intent(inout) :: cubout
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='TRANSPOSE>MEMORY'
    !
    call cubeio_message(ioseve%trans,rname,terminal%dash_strg())
    call cubeio_message(ioseve%trans,rname,'Automatic transposition in memory')
    !
    ! NB: input and output file names are useless (no meaning) for
    ! memory transposition
    call cubeio_transpose_engine(cubset,cubdef,code_buffer_memory,  &
      '','',dno,cubin,cubout,error)
    if (error)  return
    !
    call cubeio_message(ioseve%trans,rname,terminal%dash_strg())
  end subroutine cubeio_transpose_memory
  !
  subroutine cubeio_transpose_disk(cubset,cubdef,directname,transname,  &
    dno,cubin,cubout,error)
    use cubetools_terminal_tool
    !-------------------------------------------------------------------
    ! Perform the transposition from input cube on disk to output cube
    ! on disk.
    !-------------------------------------------------------------------
    type(cube_setup_t),           intent(in)    :: cubset
    type(cube_define_t),          intent(in)    :: cubdef
    character(len=*),             intent(in)    :: directname
    character(len=*),             intent(in)    :: transname
    class(cubedag_node_object_t), intent(inout) :: dno
    type(cubeio_cube_t),          intent(inout) :: cubin
    type(cubeio_cube_t),          intent(inout) :: cubout
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='TRANSPOSE>DISK'
    !
    call cubeio_message(ioseve%trans,rname,terminal%dash_strg())
    call cubeio_message(ioseve%trans,rname,'Automatic transposition from '//  &
      trim(directname)//' to '//transname)
    !
    call cubeio_transpose_engine(cubset,cubdef,code_buffer_disk,  &
      directname,transname,dno,cubin,cubout,error)
    if (error)  return
    !
    call cubeio_message(ioseve%trans,rname,terminal%dash_strg())
  end subroutine cubeio_transpose_disk
  !
  subroutine cubeio_transpose_engine(cubset,cubdef,buffering,  &
    directname,transname,dno,cubin,cubout,error)
    use cubetools_dataformat_types
    use cubetools_format
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(cube_setup_t),           intent(in)    :: cubset
    type(cube_define_t),          intent(in)    :: cubdef
    integer(kind=code_k),         intent(in)    :: buffering
    character(len=*),             intent(in)    :: directname
    character(len=*),             intent(in)    :: transname
    class(cubedag_node_object_t), intent(inout) :: dno   ! Header reloaded...
    type(cubeio_cube_t),          intent(inout) :: cubin
    type(cubeio_cube_t),          intent(inout) :: cubout
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='TRANSPOSE'
    integer(kind=chan_k) :: fchan,lchan,stepnchan
    type(cube_define_t) :: cubindef,cuboutdef
    integer(kind=pixe_k) :: fypix,lypix,stepypix
    type(cubeio_subcube_t) :: subcube
    character(len=mess_l) :: mess
    character(len=6) :: where
    !
    ! Input description
    call cubdef%copy(cubindef)
    call cubindef%set_buffering(buffering,error)
    if (error)  return
    call cubindef%set_action(code_read,error)
    if (error)  return
    if (buffering.eq.code_buffer_disk) then
      where = 'disk'
      call cubindef%set_filename(directname,error)
      if (error)  return
      call cubeio_get_header(cubset,cubindef,dno,cubin,error)
      if (error)  return
    else
      ! In memory mode, do not reload the header (as this can be a
      ! memory-only cube!). Just reset the descriptor access.
      where = 'memory'
      call cubeio_set_descriptor_external(cubset,cubindef,.true.,cubin,error)
      if (error)  return
    endif
    !
    ! Output description
    call cubdef%copy(cuboutdef)  ! Copy all except the next ones:
    cuboutdef%dofilename  = .false.
    cuboutdef%dofilekind  = .false.
    cuboutdef%dobuffering = .false.
    cuboutdef%doaction    = .false.
    call cuboutdef%set_filename(transname,error)
    if (error)  return
    call cuboutdef%set_filekind(code_dataformat_gdf,error)
    if (error)  return
    call cuboutdef%set_buffering(buffering,error)
    if (error)  return
    call cuboutdef%set_action(code_write,error)
    if (error)  return
    call cubeio_clone_header(cubset,cuboutdef,dno,cubout,error)
    if (error)  return
    !
    select case (cubout%desc%order)
    case (code_cube_imaset)
      ! Guess the internal buffer size
      ! ZZZ This should be automatic i.e cubeio_iterate_chan("as much as you can")
      if (buffering.eq.code_buffer_memory) then
        stepnchan = cubin%desc%nc
      else
        call cubin%chan_per_block(cubset%buff%block,'SET\BUFFER /BLOCK',stepnchan,error)
        if (error)  return
      endif
      write(mess,'(A,I0,3A)') 'Output file will be iterated by blocks of ',stepnchan,  &
        ' channels (',cubetools_format_memsize(stepnchan*cubout%chansize()),') in 3rd dimension'
      call cubeio_message(ioseve%trans,rname,mess)
      write(mess,'(A,I0,2A)')  'This means the input file will be traversed ', &
        (cubin%desc%nc-1)/stepnchan+1,' times from ',where
      call cubeio_message(ioseve%trans,rname,mess)
      lchan = 0
      do while (lchan.lt.cubin%desc%nc)
        fchan = lchan+1
        lchan = min(lchan+stepnchan,cubin%desc%nc)
        ! Load from buffer to subcube
        call cubeio_iterate_chan(cubset,cubindef,dno,cubin,fchan,lchan,error)
        if (error)  return
        call subcube%get(cubset,cubindef,dno,cubin,fchan,lchan,code_cube_imaset,error)
        if (error)  return
        ! Copy the subcube to the output data
        call cubeio_iterate_chan(cubset,cuboutdef,dno,cubout,fchan,lchan,error)
        if (error)  return
        call subcube%put(cubset,cuboutdef,dno,cubout,fchan,lchan,error)
        if (error)  return
      enddo
      call subcube%free(error)
      if (error)  return
      !
    case (code_cube_speset)
      ! Guess the internal buffer size
      ! ZZZ This should be automatic i.e cubeio_iterate_pix("as much as you can")
      if (buffering.eq.code_buffer_memory) then
        stepypix = cubin%desc%ny
      else
        call cubin%y_per_block(cubset%buff%block,'SET\BUFFER /BLOCK',stepypix,error)
        if (error)  return
      endif
      write(mess,'(A,I0,3A)') 'Output file will be iterated by blocks of ',stepypix,  &
        ' Y rows (',cubetools_format_memsize(stepypix*cubout%ysize()),') in 3rd dimension'
      call cubeio_message(ioseve%trans,rname,mess)
      write(mess,'(A,I0,2A)')  'This means the input file will be traversed ', &
        (cubin%desc%ny-1)/stepypix+1,' times from ',where
      call cubeio_message(ioseve%trans,rname,mess)
      lypix = 0
      do while (lypix.lt.cubin%desc%ny)
        fypix = lypix+1
        lypix = min(lypix+stepypix,cubin%desc%ny)
        ! Load from buffer to subcube
        call cubeio_iterate_pix(cubset,cubindef,dno,cubin,fypix,lypix,error)
        if (error)  return
        call subcube%get(cubset,cubindef,dno,cubin,fypix,lypix,code_cube_speset,error)
        if (error)  return
        ! Copy the subcube to the output data
        call cubeio_iterate_pix(cubset,cuboutdef,dno,cubout,fypix,lypix,error)
        if (error)  return
        call subcube%put(cubset,cuboutdef,dno,cubout,fypix,lypix,error)
        if (error)  return
      enddo
      call subcube%free(error)
      if (error)  return
      !
    case default
      call cubeio_message(seve%e,rname,'Unsupported order')
      error = .true.
      return
    end select
    !
    ! Input cube: free block buffer
    call cubeio_cube_finish(cubset,dno,cubin,error)
    if (error)  return
    ! Output cube: flush & free block buffer, finish checksum, ...
    call cubeio_cube_finish(cubset,dno,cubout,error)
    if (error)  return
    !
    ! The input and output descriptors need to be reverted as much as
    ! possible to the original 'cubdef'.
    ! 1) The original cube: reapply as is
    call cubeio_set_descriptor_external(cubset,cubdef,.true.,cubin,error)
    if (error)  return
    ! 2) Transposed cube:
    !  i) the action must be reverted from code_write to desired action
    !     in cubdef%action (usually code_read) => OK
    !  ii) the buffering must mode match the one it was created with
    call cubdef%copy(cuboutdef)
    call cuboutdef%set_buffering(buffering,error)
    if (error)  return
    call cubeio_set_descriptor_external(cubset,cuboutdef,.true.,cubout,error)
    if (error)  return
  end subroutine cubeio_transpose_engine

end module cubeio_transpose
