module cubeio_memory
  use cubetools_parameters
  use cubeio_messaging

  type cubeio_memory_t
    ! Dimensions
    integer(kind=pixe_k) :: nx = 0  ! Number of X pixels
    integer(kind=pixe_k) :: ny = 0  ! Number of Y pixels
    integer(kind=chan_k) :: nc = 0  ! Number of channels
    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 data cube
    complex(kind=sign_k), allocatable :: c4(:,:,:)  ! [nx,ny,nc] (LMV) or [nc,nx,ny] (VLM) C*4 data cube
    ! Flag
    integer(kind=code_k) :: ready = code_buffer_none  ! Is the cubeio_memory_t ready for use?
  contains
    procedure :: reallocate => cubeio_memory_reallocate
    procedure :: free       => cubeio_memory_free
    procedure :: memsize    => cubeio_memory_memsize
  end type cubeio_memory_t

  public :: cubeio_memory_t
  private

contains

  subroutine cubeio_memory_reallocate(memory,iscplx,nx,ny,nc,order,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! (Re)allocate a cubeio_memory_t
    ! Do nothing when the array sizes did not changed
    !-------------------------------------------------------------------
    class(cubeio_memory_t), intent(inout) :: memory
    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=4),        intent(in)    :: order
    logical,                intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='MEMORY>REALLOCATE'
    integer(kind=4) :: ier
    integer(kind=index_length) :: odim(3),ndim(3)
    logical :: calloc
    !
    call cubeio_message(ioseve%trace,rname,'Welcome')
    !
    ! Sanity checks
    if (nx.le.0) then
      call cubeio_message(seve%e,rname,'Number of X pixels is null or negative')
      error = .true.
    endif
    if (ny.le.0) then
      call cubeio_message(seve%e,rname,'Number of Y pixels is null or negative')
      error = .true.
    endif
    if (nc.le.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)
      ndim(1) = nx
      ndim(2) = ny
      ndim(3) = nc
    case (code_cube_speset)
      ndim(1) = nc
      ndim(2) = nx
      ndim(3) = ny
    case default
      call cubeio_message(seve%e,rname,'Unsupported data order')
      error = .true.
      return
    end select
    !
    ! Allocation or reallocation?
    if (memory%iscplx) then
      calloc = allocated(memory%c4)
    else
      calloc = allocated(memory%r4)
    endif
    if (calloc) then
      ! Reallocation?
      if (memory%iscplx) then
        odim(:) = shape(memory%c4)
      else
        odim(:) = shape(memory%r4)
      endif
      if ((memory%iscplx.eqv.iscplx) .and. all(odim.eq.ndim)) then
        ! Same type and same size => Nothing to be done!
        call cubeio_message(ioseve%alloc,rname,'Data array already allocated with correct size')
        goto 100
      else  ! Different type or different size => reallocation
        call cubeio_message(ioseve%alloc,rname,'Reallocating data array')
        call memory%free(error)
        if (error)  return
      endif
    else
      ! Allocation
      call cubeio_message(ioseve%alloc,rname,'Allocating data array')
    endif
    !
    ! Reallocate memory of the right size
    if (iscplx) then
      allocate(memory%c4(ndim(1),ndim(2),ndim(3)),stat=ier)
    else
      allocate(memory%r4(ndim(1),ndim(2),ndim(3)),stat=ier)
    endif
    if (failed_allocate(rname,'data array',ier,error)) return
    !
  100 continue
    ! Operation success
    memory%nx = nx
    memory%ny = ny
    memory%nc = nc
    memory%iscplx = iscplx
    memory%ready = code_buffer_none
  end subroutine cubeio_memory_reallocate

  subroutine cubeio_memory_free(memory,error)
    !---------------------------------------------------------------------
    ! Free a 'cubeio_memory_t' instance
    !---------------------------------------------------------------------
    class(cubeio_memory_t), intent(inout) :: memory
    logical,                intent(inout) :: error
    !
    if (memory%iscplx) then
      if (allocated(memory%c4))  deallocate(memory%c4)
    else
      if (allocated(memory%r4))  deallocate(memory%r4)
    endif
    !
    memory%iscplx = .false.
    memory%nx = 0
    memory%ny = 0
    memory%nc = 0
    memory%ready = code_buffer_none
  end subroutine cubeio_memory_free

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

end module cubeio_memory
