module cubeio_read
  use cubetools_setup_types
  use cubeio_messaging
  use cubeio_cube_define
  use cubeio_block
  use cubeio_range
  use cubeio_cube
  use cubeio_interface
  use cubeio_readwrite_iterator

  public :: cubeio_read_cube_data
  public :: cubeio_read_chan_block
  public :: cubeio_read_y_block
  public :: cubeio_read_any_block
  private

contains
  !
  subroutine cubeio_read_cube_data(cubset,cubdef,cub,error)
    !----------------------------------------------------------------------
    ! Read or prepare the data of a cube
    !----------------------------------------------------------------------
    type(cube_setup_t),  intent(in)    :: cubset
    type(cube_define_t), intent(in)    :: cubdef
    type(cubeio_cube_t), intent(inout) :: cub
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='READ>CUBE>DATA'
    !
    if (cub%ready())  return
    !
    ! Sanity
    if (cub%desc%order.eq.code_null) then
      call cubeio_message(seve%e,rname,  &
        'Attempt to get cube data while header is not loaded')
      error = .true.
      return
    endif
    ! if (cub%io%trans%do) then
    !   call cubeio_message(seve%e,rname,'Internal error: a transposition is pending')
    !   error = .true.
    !   return
    ! endif
    !
    if (cub%desc%buffered.eq.code_buffer_none)  return  ! Data is not to be read nor transposed
    !
    select case (cub%desc%buffered)
    case (code_buffer_none)
      return
    case (code_buffer_memory)
      call cubeio_message(ioseve%others,rname,'File is buffered in memory')
      call cubeio_read_all_memory(cubset,cub,error)
      if (error)  return
    case (code_buffer_disk)
      call cubeio_message(ioseve%others,rname,'File is not buffered in memory, using disk')
      call cub%memo%free(error)
      if (error)  return
    case default
      call cubeio_message(seve%e,rname,'Unexpected buffering kind')
      error = .true.
      return
    end select
    !
    cub%memo%ready = cub%desc%buffered
    !
  end subroutine cubeio_read_cube_data
  !
  subroutine cubeio_read_all_memory(cubset,cub,error)
    !-------------------------------------------------------------------
    ! Read all the cube (any order) from disk to memory.
    ! The reading process is done by blocks, with the possibility to
    ! interrupt (CTRL-C) with error.
    !-------------------------------------------------------------------
    type(cube_setup_t),  intent(in)    :: cubset
    type(cubeio_cube_t), intent(inout) :: cub
    logical,             intent(inout) :: error
    !
    type(readwrite_iterator_t) :: iter
    character(len=*), parameter :: rname='READ>ALL>MEMORY'
    !
    call cub%memo%reallocate(cub%desc%iscplx,  &
      cub%desc%nx,cub%desc%ny,cub%desc%nc,cub%desc%order,error)
    if (error) return
    !
    call iter%init(cubset,cub,'Read',error)
    if (error)  return
    !
    do while (iter%iterate(cub,error))
      if (cub%desc%iscplx) then
        call cubeio_cube_read_data(cub,iter%range, &
                                   cub%memo%c4(:,:,iter%first:iter%last),error)
      else
        call cubeio_cube_read_data(cub,iter%range, &
                                   cub%memo%r4(:,:,iter%first:iter%last),error)
      endif
      if (error)  return
    enddo
  end subroutine cubeio_read_all_memory
  !
  subroutine cubeio_read_chan_block(cubset,cub,lmvblock,error)
    !---------------------------------------------------------------------
    ! Read a LMV block of channels from LMV or VLM file on disk
    !---------------------------------------------------------------------
    type(cube_setup_t),   intent(in)    :: cubset
    type(cubeio_cube_t),  intent(inout) :: cub
    type(cubeio_block_t), intent(inout) :: lmvblock
    logical,              intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='READ>CHAN>BLOCK'
    type(cubeio_block_t) :: vlmblock
    integer(kind=pixe_k) :: iy,lmvy,vlmy,nyperblock
    integer(kind=chan_k) :: nchan,lmvchan,vlmchan
    character(len=message_length) :: mess
    type(cubeio_range_t) :: range
    integer(kind=4), parameter :: downfactor=10
    !
    ! Sanity
    if (lmvblock%order.ne.code_cube_imaset) then
      call cubeio_message(seve%e,rname,'Internal error: block is not LMV')
      error = .true.
      return
    endif
    if (cub%desc%iscplx.neqv.lmvblock%iscplx) then
      call cubeio_message(seve%e,rname,'Channel block and output cube mismatch type (R*4/C*4)')
      error = .true.
      return
    endif
    if (lmvblock%first.lt.1 .or. lmvblock%last.gt.cub%desc%nc) then
      call cubeio_message(seve%e,rname,'Internal error: invalid range')
      error = .true.
      return
    endif
    nchan = lmvblock%last-lmvblock%first+1  ! Useful size of the block
    !
    select case (cub%desc%order)
    case (code_cube_imaset)
      ! Easy: just a contiguous piece to be extracted
      range%blc(:) = 0
      range%trc(:) = 0
      range%blc(cub%desc%i3) = lmvblock%first
      range%trc(cub%desc%i3) = lmvblock%last
      if (lmvblock%iscplx) then
        call cubeio_cube_read_data(cub,range,lmvblock%c4,error)
      else
        call cubeio_cube_read_data(cub,range,lmvblock%r4,error)
      endif
      if (error)  return
      !
    case (code_cube_speset)
      ! Transposition needed: this means traversing the whole file with
      ! an intermediate buffer to collect the elements
      write(mess,'(4(A,I0))')  'Collecting LMV block ',lmvblock%first,' to ',  &
        lmvblock%last,' (over ',cub%desc%nc,') from VLM file'
      call cubeio_message(ioseve%trans,rname,mess)
      !
      call cub%y_per_block(cubset%buff%block/downfactor,'SET\BUFFER /BLOCK',nyperblock,error)
      if (error)  return
      call vlmblock%reallocatexyc(cub%desc%iscplx,cub%desc%nx,&
          nyperblock,cub%desc%nc,code_cube_speset,error)
      if (error)  return
      vlmblock%readwrite = .false.
      vlmblock%last = 0
      do iy=1,cub%desc%ny  ! For ALL Y pixel rows in VLM file
        if (iy.gt.vlmblock%last) then
          vlmblock%first = iy
          vlmblock%last = min(iy+nyperblock-1,cub%desc%ny)
          ! Note 1: we read here ALL Y pixel rows but a SUBSET of channels
          write(mess,'(2(A,I0))')  'Reading Y pixels block from ',vlmblock%first,' to ',vlmblock%last
          call cubeio_message(ioseve%trans,rname,mess)
          call cubeio_read_y_block(cubset,cub,vlmblock,error)
          if (error)  return
        endif
        ! Note 2: we write here a SUBSET of channels for current Y pixel row
        lmvy =  iy                    ! Position of first pixel of this Y row in lmvblock
        vlmy = (iy-vlmblock%first+1)  ! Position of first pixel of this Y row in vlmblock
        if (lmvblock%iscplx) then
          do lmvchan=1,nchan  ! For the desired SUBSET of channels
            vlmchan = lmvchan+lmvblock%first-1
            lmvblock%c4(:,lmvy,lmvchan) = vlmblock%c4(vlmchan,:,vlmy)
          enddo
        else
          do lmvchan=1,nchan  ! For the desired SUBSET of channels
            vlmchan = lmvchan+lmvblock%first-1
            lmvblock%r4(:,lmvy,lmvchan) = vlmblock%r4(vlmchan,:,vlmy)
          enddo
        endif
      enddo
      !
      call vlmblock%free(error)
      !
    case default
      call cubeio_message(seve%e,rname,'Unsupported cube order')
      error = .true.
      return
    end select
  end subroutine cubeio_read_chan_block
  !
  subroutine cubeio_read_y_block(cubset,cub,vlmblock,error)
    !---------------------------------------------------------------------
    ! Read a VLM block of channels from VLM or LMV file on disk
    !---------------------------------------------------------------------
    type(cube_setup_t),   intent(in)    :: cubset
    type(cubeio_cube_t),  intent(inout) :: cub
    type(cubeio_block_t), intent(inout) :: vlmblock
    logical,              intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='READ>Y>BLOCK'
    type(cubeio_block_t) :: lmvblock
    integer(kind=chan_k) :: ichan,lmvchan,vlmchan,nchanperblock
    integer(kind=pixe_k) :: ny,lmvy,vlmy
    character(len=message_length) :: mess
    type(cubeio_range_t) :: range
    integer(kind=4), parameter :: downfactor=10
    !
    ! Sanity
    if (vlmblock%order.ne.code_cube_speset) then
      call cubeio_message(seve%e,rname,'Internal error: block is LMV')
      error = .true.
      return
    endif
    if (cub%desc%iscplx.neqv.vlmblock%iscplx) then
      call cubeio_message(seve%e,rname,'Y rows block and output cube mismatch type (R*4/C*4)')
      error = .true.
      return
    endif
    if (vlmblock%first.lt.1 .or. vlmblock%last.gt.cub%desc%ny) then
      call cubeio_message(seve%e,rname,'Internal error: invalid range')
      error = .true.
      return
    endif
    ny = vlmblock%last-vlmblock%first+1  ! Useful size of the block
    !
    select case (cub%desc%order)
    case (code_cube_speset)
      ! Easy: just a contiguous piece to be extracted
      range%blc(:) = 0
      range%trc(:) = 0
      range%blc(cub%desc%i3) = vlmblock%first
      range%trc(cub%desc%i3) = vlmblock%last
      if (lmvblock%iscplx) then
        call cubeio_cube_read_data(cub,range,vlmblock%c4,error)
      else
        call cubeio_cube_read_data(cub,range,vlmblock%r4,error)
      endif
      if (error)  return
      !
    case (code_cube_imaset)
      ! Transposition needed: this means traversing the whole file with
      ! an intermediate buffer to collect the elements
      write(mess,'(4(A,I0))')  'Collecting VLM block ',vlmblock%first,' to ',  &
        vlmblock%last,' (over ',cub%desc%ny,') from LMV file'
      call cubeio_message(ioseve%trans,rname,mess)
      !
      call cub%chan_per_block(cubset%buff%block/downfactor,'SET\BUFFER /BLOCK',nchanperblock,error)
      if (error)  return
      call lmvblock%reallocatexyc(cub%desc%iscplx,&
          cub%desc%nx,cub%desc%ny,nchanperblock,code_cube_imaset,error)
      if (error)  return
      lmvblock%readwrite = .false.
      lmvblock%last = 0
      do ichan=1,cub%desc%nc  ! For ALL channels in LMV file
        if (ichan.gt.lmvblock%last) then
          lmvblock%first = ichan
          lmvblock%last = min(ichan+nchanperblock-1,cub%desc%nc)
          ! Note 1: we read here ALL channels but a SUBSET of Y rows
          write(mess,'(2(A,I0))')  'Reading channel block from ',lmvblock%first,' to ',lmvblock%last
          call cubeio_message(ioseve%trans,rname,mess)
          call cubeio_read_chan_block(cubset,cub,lmvblock,error)
          if (error)  return
        endif
        ! Note 2: we write here a SUBSET of Y rows for current channel
        vlmchan =  ichan                    ! Position of first pixel of this channel in vlmblock
        lmvchan = (ichan-lmvblock%first+1)  ! Position of first pixel of this channel in lmvblock
        if (vlmblock%iscplx) then
          do vlmy=1,ny  ! For the desired SUBSET of Y rows
            lmvy = vlmy+vlmblock%first-1
            vlmblock%c4(vlmchan,:,vlmy) = lmvblock%c4(:,lmvy,lmvchan)
          enddo
        else
          do vlmy=1,ny  ! For the desired SUBSET of Y rows
            lmvy = vlmy+vlmblock%first-1
            vlmblock%r4(vlmchan,:,vlmy) = lmvblock%r4(:,lmvy,lmvchan)
          enddo
        endif
      enddo
      !
      call lmvblock%free(error)
      !
    case default
      call cubeio_message(seve%e,rname,'Unsupported cube order')
      error = .true.
      return
    end select
  end subroutine cubeio_read_y_block
  !
  subroutine cubeio_read_any_block(cubset,cub,anyblock,error)
    !---------------------------------------------------------------------
    ! Read a block of planes from file on disk
    !---------------------------------------------------------------------
    type(cube_setup_t),   intent(in)    :: cubset
    type(cubeio_cube_t),  intent(inout) :: cub
    type(cubeio_block_t), intent(inout) :: anyblock
    logical,              intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='READ>ANY>BLOCK'
    integer(kind=data_k) :: n3
    type(cubeio_range_t) :: range
    !
    ! Sanity
    if (anyblock%order.ne.code_cube_unkset) then  ! ZZZ Is this test relevant?
      call cubeio_message(seve%e,rname,'Internal error: block has not ANY order')
      error = .true.
      return
    endif
    if (cub%desc%iscplx.neqv.anyblock%iscplx) then
      call cubeio_message(seve%e,rname,'Block and output cube mismatch type (R*4/C*4)')
      error = .true.
      return
    endif
    if (anyblock%first.lt.1 .or. anyblock%last.gt.cub%desc%n3) then
      call cubeio_message(seve%e,rname,'Internal error: invalid range')
      error = .true.
      return
    endif
    n3 = anyblock%last-anyblock%first+1  ! Useful size of the block
    !
    select case (cub%desc%order)
    case (code_cube_imaset,code_cube_speset)
      ! Easy: just a contiguous piece to be extracted
      range%blc(:) = 0
      range%trc(:) = 0
      range%blc(cub%desc%i3) = anyblock%first
      range%trc(cub%desc%i3) = anyblock%last
      if (anyblock%iscplx) then
        call cubeio_cube_read_data(cub,range,anyblock%c4,error)
      else
        call cubeio_cube_read_data(cub,range,anyblock%r4,error)
      endif
      if (error)  return
      !
    case default
      call cubeio_message(seve%e,rname,'Unsupported cube order')
      error = .true.
      return
    end select
  end subroutine cubeio_read_any_block

end module cubeio_read
