module cubeio_pix
  use cubetools_parameters
  use cubetools_setup_types
  use cubedag_node_type
  use cubeio_messaging
  use cubeio_cube_define
  use cubeio_cube
  use cubeio_flush
  use cubeio_read
  use cubeio_write

  type cube_pix_t
    integer(kind=chan_k) :: nc = 0                         ! Number of channels
    integer(kind=4)      :: allocated = code_pointer_null  !
    logical              :: iscplx = .false.               ! R*4 or C*4?
    real(kind=sign_k),    pointer :: r4(:) => null()       ! [nc]
    complex(kind=sign_k), pointer :: c4(:) => null()       ! [nc]
  end type cube_pix_t

  private
  public :: cube_pix_t
  public :: cubeio_get_pix,cubeio_put_pix
  public :: cubeio_free_pix
  public :: cubeio_iterate_pix

contains

  subroutine cubeio_reallocate_pix(cubset,pix,iscplx,nc,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! (Re)allocate a cube_pix_t
    ! Do nothing when the array sizes do not need to change
    !-------------------------------------------------------------------
    type(cube_setup_t),     intent(in)    :: cubset
    type(cube_pix_t),       intent(inout) :: pix
    logical,                intent(in)    :: iscplx
    integer(kind=chan_k),   intent(in)    :: nc
    logical,                intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='REALLOCATE>CUBE>PIX'
    integer(kind=4) :: ier
    !
    call cubeio_message(ioseve%trace,rname,'Welcome')
    !
    ! Sanity checks
    if (nc.le.0) then
      call cubeio_message(seve%e,rname,'Number of channels is null or negative')
      error = .true.
      if (error)  return
    endif
    !
    ! Allocation or reallocation?
    if (pix%allocated.eq.code_pointer_allocated) then
      ! Reallocation?
      if ((pix%iscplx.eqv.iscplx) .and. pix%nc.eq.nc) then
        ! Same type and same size => Nothing to be done!
        call cubeio_message(ioseve%alloc,rname,'Pixel array already allocated with correct size')
        goto 100
      else  ! Different type or different size => reallocation
        call cubeio_message(ioseve%alloc,rname,'Reallocating pixel array')
        call cubeio_free_pix(pix,error)
        if (error)  return
      endif
    else
      ! Allocation
      call cubeio_message(ioseve%alloc,rname,'Creating pixel array')
    endif
    !
    ! Reallocate memory of the right size
    if (iscplx) then
      allocate(pix%c4(nc),stat=ier)
    else
      allocate(pix%r4(nc),stat=ier)
    endif
    if (failed_allocate(rname,'Pixel array',ier,error)) return
    !
  100 continue
    ! Operation success
    pix%nc = nc
    pix%iscplx = iscplx
    pix%allocated = code_pointer_allocated
    !
  end subroutine cubeio_reallocate_pix

  subroutine cubeio_free_pix(pix,error)
    !---------------------------------------------------------------------
    ! Free a 'cube_pix_t' instance
    !---------------------------------------------------------------------
    type(cube_pix_t), intent(inout) :: pix
    logical,          intent(inout) :: error
    !
    if (pix%allocated.eq.code_pointer_allocated) then
      if (pix%iscplx) then
        deallocate(pix%c4)
      else
        deallocate(pix%r4)
      endif
    endif
    !
    pix%nc = 0
    pix%allocated = code_pointer_null
    pix%iscplx = .false.
    pix%c4 => null()
    pix%r4 => null()
    !
  end subroutine cubeio_free_pix

  subroutine cubeio_get_pix(cubset,cubdef,dno,cub,xpix,ypix,pix,error)
    !---------------------------------------------------------------------
    ! Get all data (Nc) for the desired pixel
    !---------------------------------------------------------------------
    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) :: cub
    integer(kind=pixe_k),         intent(in)    :: xpix,ypix
    type(cube_pix_t),             intent(inout) :: pix
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='GET>PIX'
    character(len=message_length) :: mess
    integer(kind=pixe_k) :: doxpix,doypix
    !
    if (.not.cub%ready()) then
      call cubeio_message(seve%e,rname,'Internal error: cube data is not ready')
      error = .true.
      return
    endif
    doxpix = cub%x_num(xpix)
    doypix = cub%y_num(ypix)
    if (doxpix.le.0 .or. doxpix.gt.cub%desc%nx) then
      write(mess,'(2(A,I0))')  'X pixel number ',doxpix,' out of range 1 - ',cub%desc%nx
      call cubeio_message(seve%e,rname,mess)
      error = .true.
    endif
    if (doypix.le.0 .or. doypix.gt.cub%desc%ny) then
      write(mess,'(2(A,I0))')  'Y pixel number ',doypix,' out of range 1 - ',cub%desc%ny
      call cubeio_message(seve%e,rname,mess)
      error = .true.
    endif
    if (error)  return
    !
    select case (cub%desc%buffered)
    case (code_buffer_memory)
      call cubeio_get_pix_from_memory(cubset,cub,doxpix,doypix,pix,error)
    case (code_buffer_disk)
      call cubeio_get_pix_from_block(cubset,dno,cub,doxpix,doypix,pix,error)
    case default
      call cubeio_message(seve%e,rname,'Unexpected cube buffering')
      error = .true.
    end select
    if (error)  return
    !
  end subroutine cubeio_get_pix

  subroutine cubeio_get_pix_from_memory(cubset,cub,xpix,ypix,pix,error)
    !---------------------------------------------------------------------
    ! Get all data (Nc) for the desired pixel, in the context of memory
    ! mode. In return, the 'pix' points to the cube data buffer.
    ! --
    ! Do not call directly, use cubeio_get_pix instead.
    !---------------------------------------------------------------------
    type(cube_setup_t),          intent(in)    :: cubset
    type(cubeio_cube_t), target, intent(in)    :: cub
    integer(kind=pixe_k),        intent(in)    :: xpix
    integer(kind=pixe_k),        intent(in)    :: ypix
    type(cube_pix_t),            intent(inout) :: pix
    logical,                     intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='GET>PIX'
    !
    select case (cub%desc%order)
    case (code_cube_speset)
      ! Data is simply associated to VLM buffer
      ! ZZZ deallocate if needed before associating!
      pix%nc =  cub%memo%nc
      if (cub%memo%iscplx) then
        pix%c4 => cub%memo%c4(:,xpix,ypix)
      else
        pix%r4 => cub%memo%r4(:,xpix,ypix)
      endif
      pix%iscplx = cub%memo%iscplx
      pix%allocated = code_pointer_associated
    case (code_cube_imaset)
      ! Data is copied/duplicated from LMV buffer
      call cubeio_reallocate_pix(cubset,pix,cub%memo%iscplx,cub%memo%nc,error)
      if (error)  return
      ! Non-contiguous (inefficient) copy
      if (cub%memo%iscplx) then
        pix%c4(:) = cub%memo%c4(xpix,ypix,:)
      else
        pix%r4(:) = cub%memo%r4(xpix,ypix,:)
      endif
    case (code_table_speset)
      ! Data is simply associated to TAB buffer
      ! ZZZ deallocate if needed before associating!
      pix%nc = cub%memo%nc-3  ! ZZZ Should introduce a 'ldaps' count
      pix%r4 => cub%memo%r4(4:cub%memo%nc,xpix,ypix)
      pix%iscplx = cub%memo%iscplx
      pix%allocated = code_pointer_associated
    case default
      call cubeio_message(seve%e,rname,'No data available')
      error = .true.
      return
    end select
  end subroutine cubeio_get_pix_from_memory

  subroutine cubeio_get_pix_from_block(cubset,dno,cub,xpix,ypix,pix,error)
    !---------------------------------------------------------------------
    ! Get all data (Nc) for the desired pixel, in the context of disk
    ! mode. In return, the 'pix' points to a memory buffer that is
    ! intended to disappear as others pixels are accessed => no warranty
    ! the pointer remains valid after another call.
    ! --
    ! Do not call directly, use cubeio_get_pix instead.
    !---------------------------------------------------------------------
    type(cube_setup_t),           intent(in)    :: cubset
    class(cubedag_node_object_t), intent(inout) :: dno
    type(cubeio_cube_t), target,  intent(inout) :: cub
    integer(kind=pixe_k),         intent(in)    :: xpix
    integer(kind=pixe_k),         intent(in)    :: ypix
    type(cube_pix_t),             intent(inout) :: pix
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='GET>PIX'
    integer(kind=pixe_k) :: bypix
    !
    if (cub%desc%order.ne.code_cube_speset) then
      call cubeio_message(seve%e,rname,'Reading a pixel from disk in a LMV file is prohibitive')
      call cubeio_message(seve%e,rname,'Transpose LMV file to VLM file and then READ it')
      error = .true.
      return
    endif
    !
    call cubeio_check_input_pix_block(cubset,dno,cub,ypix,ypix,error)
    if (error)  return
    !
    ! Point pixel data from correct position in pix%block
    bypix = ypix-cub%file%block%first+1  ! Position in pix%block
    ! ZZZ deallocate if needed before associating!
    pix%nc = cub%desc%nc
    if (cub%file%block%iscplx) then
      pix%c4 => cub%file%block%c4(:,xpix,bypix)
    else
      pix%r4 => cub%file%block%r4(:,xpix,bypix)
    endif
    pix%iscplx = cub%file%block%iscplx
    pix%allocated = code_pointer_associated
  end subroutine cubeio_get_pix_from_block
  !
  subroutine cubeio_put_pix(cubset,cubdef,dno,cub,xpix,ypix,pix,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Put all data (Nc) for the desired pixel
    ! (This is symetric to cubeio_get_pix)
    !-------------------------------------------------------------------
    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) :: cub
    integer(kind=pixe_k),         intent(in)    :: xpix
    integer(kind=pixe_k),         intent(in)    :: ypix
    type(cube_pix_t),             intent(in)    :: pix
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='PUT>PIX'
    character(len=message_length) :: mess
    !
    if (.not.cub%ready()) then
      call cubeio_message(seve%e,rname,'Internal error: cube data is not ready')
      error = .true.
      return
    endif
    if (xpix.le.0 .or. xpix.gt.cub%desc%nx) then
      write(mess,'(A,I0,A,I0,A)')  &
        'X pixel number out of range (',xpix,'/',cub%desc%nx,')'
      call cubeio_message(seve%e,rname,mess)
      error = .true.
    endif
    if (ypix.le.0 .or. ypix.gt.cub%desc%ny) then
      write(mess,'(A,I0,A,I0,A)')  &
        'Y pixel number out of range (',ypix,'/',cub%desc%ny,')'
      call cubeio_message(seve%e,rname,mess)
      error = .true.
    endif
    if (pix%nc.ne.cub%desc%nc) then
      write(mess,'(3(A,I0))')  'Number of channels mismatch: attempt to put ',  &
        pix%nc,' channels while output cube has ',cub%desc%nc,' channels'
      call cubeio_message(seve%e,rname,mess)
      error = .true.
    endif
    if (pix%iscplx.neqv.cub%desc%iscplx) then
      call cubeio_message(seve%e,rname,'Pixel and output cube type mismatch (R*4/C*4)')
      error = .true.
    endif
    if (error)  return
    !
    select case (cub%desc%buffered)
    case (code_buffer_memory)
      call cubeio_put_pix_to_data(cubset,cub,xpix,ypix,pix,error)
    case (code_buffer_disk)
      call cubeio_put_pix_to_block(cubset,dno,cub,xpix,ypix,pix,error)
    case default
      call cubeio_message(seve%e,rname,'Unexpected cube data buffering')
      error = .true.
      return
    end select
    !
  end subroutine cubeio_put_pix
  !
  subroutine cubeio_put_pix_to_data(cubset,cub,xpix,ypix,pix,error)
    !-------------------------------------------------------------------
    ! Write a single channel to the cubeio_memory_t, in the context of
    ! memory mode.
    ! ---
    ! Do not call directly, use cubeio_put_pix instead.
    !-------------------------------------------------------------------
    type(cube_setup_t),   intent(in)    :: cubset
    type(cubeio_cube_t),  intent(inout) :: cub
    integer(kind=pixe_k), intent(in)    :: xpix
    integer(kind=pixe_k), intent(in)    :: ypix
    type(cube_pix_t),     intent(in)    :: pix
    logical,              intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='PUT>PIX'
    !
    select case (cub%desc%order)
    case (code_cube_speset)
      if (cub%memo%iscplx) then
        cub%memo%c4(:,xpix,ypix) = pix%c4(:)
      else
        cub%memo%r4(:,xpix,ypix) = pix%r4(:)
      endif
    case (code_cube_imaset)
      ! Non-contiguous (inefficient) copies
      if (cub%memo%iscplx) then
        cub%memo%c4(xpix,ypix,:) = pix%c4(:)
      else
        cub%memo%r4(xpix,ypix,:) = pix%r4(:)
      endif
    case default
      call cubeio_message(seve%e,rname,'No data available')
      error = .true.
      return
    end select
    !
  end subroutine cubeio_put_pix_to_data
  !
  subroutine cubeio_put_pix_to_block(cubset,dno,cub,xpix,ypix,pix,error)
    !-------------------------------------------------------------------
    ! Write a single channel to the cubeio_block_t, in the context of
    ! disk mode.
    ! ---
    ! Do not call directly, use cubeio_put_pix instead.
    !-------------------------------------------------------------------
    type(cube_setup_t),           intent(in)    :: cubset
    class(cubedag_node_object_t), intent(inout) :: dno
    type(cubeio_cube_t),          intent(inout) :: cub
    integer(kind=pixe_k),         intent(in)    :: xpix
    integer(kind=pixe_k),         intent(in)    :: ypix
    type(cube_pix_t),             intent(in)    :: pix
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='PUT>PIX'
    integer(kind=pixe_k) :: by
    integer(kind=size_length) :: ndata
    !
    if (cub%desc%order.ne.code_cube_speset) then
      call cubeio_message(seve%e,rname,'Writing a pixel to disk in a LMV file is impossible')
      error = .true.
      return
    endif
    if (cub%file%block%iscplx.neqv.pix%iscplx) then
      call cubeio_message(seve%e,rname,'Pixel and output cube mismatch type (R*4/C*4)')
      error = .true.
      return
    endif
    !
    call cubeio_check_output_pix_block(cubset,dno,cub,ypix,ypix,error)
    if (error)  return
    !
    ! Buffer might already be in memory but read-only: switch to read-write
    cub%file%block%readwrite = .true.
    !
    ! Write DATA to cub%file%block buffer
    by = ypix-cub%file%block%first+1  ! Position in cub%file%block
    ndata = cub%desc%nc
    if (cub%file%block%iscplx) then
      call c4toc4_sl(pix%c4,cub%file%block%c4(1,xpix,by),ndata)
    else
      call r4tor4_sl(pix%r4,cub%file%block%r4(1,xpix,by),ndata)
    endif
  end subroutine cubeio_put_pix_to_block

  subroutine cubeio_iterate_pix(cubset,cubdef,dno,cub,fypix,lypix,error)
    !---------------------------------------------------------------------
    ! Prepare buffers for working (at least) on the requested Y pixel row
    ! range
    !---------------------------------------------------------------------
    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) :: cub
    integer(kind=pixe_k),         intent(in)    :: fypix
    integer(kind=pixe_k),         intent(in)    :: lypix
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='ITERATE>PIX'
    !
    select case (cub%desc%action)
    case (code_read_head)
      call cubeio_message(seve%e,rname,'Access to data not allowed for action read-header')
      error = .true.
    case (code_read,code_update)
      call cubeio_iterate_read_pix(cubset,cubdef,dno,cub,fypix,lypix,error)
    case (code_write)
      call cubeio_iterate_write_pix(cubset,cubdef,dno,cub,fypix,lypix,error)
    case default
      call cubeio_message(seve%e,rname,'Unexpected action mode')
      error = .true.
    end select
  end subroutine cubeio_iterate_pix

  subroutine cubeio_iterate_read_pix(cubset,cubdef,dno,icub,fypix,lypix,error)
    !---------------------------------------------------------------------
    ! Pre-load all or part of the data from disk in a buffer which
    ! provides (at least) the requested Y pixel row range.
    !---------------------------------------------------------------------
    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) :: icub
    integer(kind=pixe_k),         intent(in)    :: fypix
    integer(kind=pixe_k),         intent(in)    :: lypix
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='ITERATE>READ>PIX'
    !
    ! On first iteration, read or prepare the cube data (does nothing on
    ! subsequent iterations):
    call cubeio_read_cube_data(cubset,cubdef,icub,error)
    if (error)  return
    !
    ! Work to be done on next iterations
    select case (icub%desc%buffered)
    case (code_buffer_none)
      return
    case (code_buffer_memory)
      return
    case (code_buffer_disk)
      ! Ensure the proper buffer is available in memory
      call cubeio_check_input_pix_block(cubset,dno,icub,fypix,lypix,error)
      if (error)  return
    case default
      call cubeio_message(seve%e,rname,'Unexpected buffering kind')
      error = .true.
      return
    end select
  end subroutine cubeio_iterate_read_pix

  subroutine cubeio_iterate_write_pix(cubset,cubdef,dno,ocub,fypix,lypix,error)
    !---------------------------------------------------------------------
    ! Prepare a buffer covering all or part of the data, providing
    ! (at least) the requested Y pixel row range
    !---------------------------------------------------------------------
    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) :: ocub
    integer(kind=pixe_k),         intent(in)    :: fypix
    integer(kind=pixe_k),         intent(in)    :: lypix
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='ITERATE>WRITE>PIX'
    !
    ! On first iteration, prepare the cube data (does nothing on
    ! subsequent iterations):
    call cubeio_create_cube_data(cubset,cubdef,dno,ocub,error)
    if (error)  return
    !
    select case (ocub%desc%buffered)
    case (code_buffer_none)
      return
    case (code_buffer_memory)
      return
    case (code_buffer_disk)
      ! Ensure the proper buffer is available in memory
      call cubeio_check_output_pix_block(cubset,dno,ocub,fypix,lypix,error)
      if (error)  return
    case default
      call cubeio_message(seve%e,rname,'Unexpected buffering kind')
      error = .true.
      return
    end select
  end subroutine cubeio_iterate_write_pix

end module cubeio_pix
