module cubeio_block
  !---------------------------------------------------------------------
  ! Define a "monoblock" type which reflects the way the data is stored
  ! in file
  !---------------------------------------------------------------------
  use cubetools_parameters
  use cubetools_setup_types
  use cubeio_messaging

  type cubeio_block_t
    integer(kind=4)            :: order = code_null ! UVT or TUV order?
    logical                    :: iscplx = .false.  ! R*4 or C*4?
    real(kind=sign_k),    allocatable :: r4(:,:,:)  ! [nx,ny,nc] (LMV) or [nc,nx,ny] (VLM) R*4 cube slice
    complex(kind=sign_k), allocatable :: c4(:,:,:)  ! [nx,ny,nc] (LMV) or [nc,nx,ny] (VLM) C*4 cube slice
    integer(kind=index_length) :: dim1              ! First dimension (size of alloc), strict
    integer(kind=index_length) :: dim2              ! Second dimension (size of alloc), strict
    integer(kind=index_length) :: dim3              ! Third dimension (size of alloc), maximum available
    integer(kind=index_length) :: first             ! First element of last dimension mapped by the block
    integer(kind=index_length) :: last              ! Last element of last dimension mapped by the block
    logical                    :: readwrite         ! Is this block opened read-only or read-write?
  contains
    procedure, public :: reallocate123 => cubeio_block_reallocate_123
    procedure, public :: reallocatexyc => cubeio_block_reallocate_xyc
    procedure, public :: free          => cubeio_block_free
    procedure, public :: memsize       => cubeio_block_memsize
  end type cubeio_block_t

  public :: cubeio_block_t
  private

contains

  subroutine cubeio_block_reallocate_xyc(block,iscplx,nx,ny,nc,order,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! (Re)allocate a cubeio_block_t
    ! Do nothing when the array sizes do not need to change.
    ! ---
    ! This version with nx ny nc as argument
    !-------------------------------------------------------------------
    class(cubeio_block_t), intent(inout) :: block
    logical,               intent(in)    :: iscplx
    integer(kind=pixe_k),  intent(in)    :: nx
    integer(kind=pixe_k),  intent(in)    :: ny
    integer(kind=chan_k),  intent(in)    :: nc
    integer(kind=code_k),  intent(in)    :: order
    logical,               intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='BLOCK>REALLOCATE>XYC'
    integer(kind=data_k) :: dim1,dim2,dim3
    !
    call cubeio_message(ioseve%trace,rname,'Welcome')
    !
    ! Sanity checks
    if (nx.lt.0) then
      call cubeio_message(seve%e,rname,'Number of X pixels is null or negative')
      error = .true.
    endif
    if (ny.lt.0) then
      call cubeio_message(seve%e,rname,'Number of Y pixels is null or negative')
      error = .true.
    endif
    if (nc.lt.0) then
      call cubeio_message(seve%e,rname,'Number of channels is null or negative')
      error = .true.
    endif
    if (error)  return
    !
    select case (order)
    case (code_cube_imaset)
      dim1 = max(1,nx)
      dim2 = max(1,ny)
      dim3 = max(1,nc)
    case (code_cube_speset)
      dim1 = max(1,nc)
      dim2 = max(1,nx)
      dim3 = max(1,ny)
    case default
      call cubeio_message(seve%e,rname,'Unsupported data order')
      error = .true.
      return
    end select
    !
    call cubeio_block_reallocate_123(block,iscplx,dim1,dim2,dim3,order,error)
    if (error)  return
    !
  end subroutine cubeio_block_reallocate_xyc

  subroutine cubeio_block_reallocate_123(block,iscplx,dim1,dim2,dim3,order,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! (Re)allocate a cubeio_block_t
    ! Do nothing when the array sizes do not need to change.
    ! ---
    ! This version with dim1 dim2 dim3 as argument
    !-------------------------------------------------------------------
    class(cubeio_block_t), intent(inout) :: block
    logical,               intent(in)    :: iscplx
    integer(kind=data_k),  intent(in)    :: dim1
    integer(kind=data_k),  intent(in)    :: dim2
    integer(kind=data_k),  intent(in)    :: dim3
    integer(kind=code_k),  intent(in)    :: order
    logical,               intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='BLOCK>REALLOCATE>123'
    integer(kind=4) :: ier
    logical :: calloc
    !
    ! Allocation or reallocation?
    if (block%iscplx) then
      calloc = allocated(block%c4)
    else
      calloc = allocated(block%r4)
    endif
    if (calloc) then
      ! Reallocation?
      if ((block%iscplx.eqv.iscplx) .and. block%dim1.eq.dim1 .and.  &
          block%dim2.eq.dim2 .and. block%dim3.eq.dim3) then
        ! Same type and same size => Nothing to be done!
        call cubeio_message(ioseve%alloc,rname,'Block array already allocated with correct size')
        goto 100
      else  ! Different type or different size => reallocation
        call cubeio_message(ioseve%alloc,rname,'Reallocating block array')
        call block%free(error)
        if (error)  return
      endif
    else
      ! Allocation
      call cubeio_message(ioseve%alloc,rname,'Creating block array')
    endif
    !
    ! Reallocate memory of the right size
    if (iscplx) then
      allocate(block%c4(dim1,dim2,dim3),stat=ier)
    else
      allocate(block%r4(dim1,dim2,dim3),stat=ier)
    endif
    if (failed_allocate(rname,'Block array',ier,error)) return
    !
  100 continue
    ! Operation success
    block%order  = order
    block%iscplx = iscplx
    block%dim1   = dim1
    block%dim2   = dim2
    block%dim3   = dim3
    block%first  = 0
    block%last   = 0
    block%readwrite = .false.
  end subroutine cubeio_block_reallocate_123

  subroutine cubeio_block_free(block,error)
    !---------------------------------------------------------------------
    ! Free a 'cubeio_block_t' instance
    !---------------------------------------------------------------------
    class(cubeio_block_t), intent(inout) :: block
    logical,               intent(inout) :: error
    !
    block%order     = 0
    block%iscplx    = .false.
    if (allocated(block%c4))  deallocate(block%c4)
    if (allocated(block%r4))  deallocate(block%r4)
    block%dim1      = 0
    block%dim2      = 0
    block%dim3      = 0
    block%first     = 0
    block%last      = 0
    block%readwrite = .false.
  end subroutine cubeio_block_free

  function cubeio_block_memsize(block)
    !-------------------------------------------------------------------
    ! Return the memory footprint in bytes
    !-------------------------------------------------------------------
    integer(kind=size_length) :: cubeio_block_memsize
    class(cubeio_block_t), intent(in) :: block
    !
    cubeio_block_memsize = 0
    !
    if (allocated(block%r4)) &
      cubeio_block_memsize = cubeio_block_memsize + size(block%r4,kind=size_length)*4
    !
    if (allocated(block%c4)) &
      cubeio_block_memsize = cubeio_block_memsize + size(block%c4,kind=size_length)*8
    !
  end function cubeio_block_memsize

end module cubeio_block
