!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module mrtcal_chunkset_types
  use gildas_def
  use gkernel_interfaces
  use mrtcal_chunk_types
  use mrtcal_messaging
  !
  private
  public :: chunkset_t
  !
  type chunkset_t
    integer(kind=4)        :: n   ! Number of chunks in this set
    type(chunk_t), pointer :: chunks(:) => null() ! [ n ] The chunks
    integer(kind=4)        :: allocated=code_pointer_null ! Allocated or just associated?
  contains
    procedure, public :: reallocate  => reallocate_chunkset
    procedure, public :: reassociate => reassociate_chunkset
    procedure, public :: free        => free_chunkset
    procedure, public :: nullify     => nullify_chunkset
    procedure, public :: clone       => clone_chunkset
    procedure, public :: init_data   => chunkset_init_data
    procedure, public :: consistency => chunkset_consistency
  end type chunkset_t
  !
contains
  !
  subroutine reallocate_chunkset(chunkset,n,error)
    !-------------------------------------------------------------------
    ! (Re)allocate a chunkset so that it can store n chunks.
    !
    ! Nothing is done for the chunks in the chunkset. The caller is free
    ! to allocate them or associate them depending on its need.
    !-------------------------------------------------------------------
    class(chunkset_t), intent(inout) :: chunkset
    integer(kind=4),   intent(in)    :: n
    logical,           intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='REALLOCATE>CHUNKSET'
    logical :: alloc
    character(len=message_length) :: mess
    integer(kind=4) :: ier
    !
    call mrtcal_message(seve%t,rname,'Welcome')
    !
    if (n.le.0) then
      write(mess,'(A,I0,A)')  'Array size can not be zero nor negative (got ',n,')'
      call mrtcal_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    alloc = .true.
    if (chunkset%allocated.eq.code_pointer_associated) then
      call mrtcal_message(seve%e,rname,  &
        'Internal error: attempt to allocate an associated pointer')
      error = .true.
      return
    elseif (chunkset%allocated.eq.code_pointer_allocated) then
       if (.not.associated(chunkset%chunks)) then
         ! How come!?!? chunkset has code 'allocated' but its pointer is
         ! not associated? Something wrong, need fix.
         call mrtcal_message(seve%e,rname,  &
           'Internal error: CHUNKSET is expected to be associated but is not')
         error = .true.
         return
       endif
       if (chunkset%n.eq.n) then
          write(mess,'(a,i0)')  &
            'CHUNKSET already associated at the right size: ',n
          call mrtcal_message(seve%d,rname,mess)
          alloc = .false.
       else
          call mrtcal_message(seve%d,rname,  &
            'CHUNKSET pointer already associated but with a different size => Freeing it first')
          call chunkset%free(error)
          if (error)  return
       endif
    endif
    !
    if (alloc) then
       allocate(chunkset%chunks(n),stat=ier)
       if (failed_allocate(rname,'CHUNKSET',ier,error)) then
          call chunkset%free(error)
          return
       endif
       chunkset%allocated = code_pointer_allocated
       write(mess,'(a,i0)') 'Allocated CHUNKSET of size: ',n
       call mrtcal_message(seve%d,rname,mess)
    endif
    !
    ! Allocation success => Initialize
    chunkset%n = n
  end subroutine reallocate_chunkset
  !
  subroutine reassociate_chunkset(ou,in,error,ichunk)
    !---------------------------------------------------------------------
    !  Associate a chunkset onto another one.
    !  If 'ichunk' is present, associate only onto this single element
    !  (pointer to subset).
    !---------------------------------------------------------------------
    class(chunkset_t),         intent(inout) :: ou
    type(chunkset_t),          intent(in)    :: in
    logical,                   intent(inout) :: error
    integer(kind=4), optional, intent(in)    :: ichunk
    ! Local
    character(len=*), parameter :: rname='REASSOCIATE>CHUNKSET'
    integer(kind=4) :: first,last
    !
    call mrtcal_message(seve%t,rname,'Welcome')
    !
    if (present(ichunk)) then
      if (ichunk.lt.1 .or. ichunk.gt.in%n) then
        call mrtcal_message(seve%e,rname,'Invalid chunk number')
        error = .true.
        return
      endif
      first = ichunk
      last = first
    else
      first = 1
      last = in%n
    endif
    !
    if (ou%allocated.eq.code_pointer_allocated) then
      call ou%free(error)
      if (error)  return
    endif
    !
    ou%n = last-first+1
    ou%chunks => in%chunks(first:last)
    ou%allocated = code_pointer_associated
  end subroutine reassociate_chunkset
  !
  subroutine free_chunkset(chunkset,error)
    !-------------------------------------------------------------------
    ! Free a chunkset
    !-------------------------------------------------------------------
    class(chunkset_t), intent(inout) :: chunkset
    logical,           intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='FREE>CHUNKSET'
    integer(kind=4) :: ichunk
    !
    call mrtcal_message(seve%t,rname,'Welcome')
    !
    if (chunkset%allocated.eq.code_pointer_associated) then
      call chunkset%nullify(error)
      if (error)  return
      !
    elseif (chunkset%allocated.eq.code_pointer_allocated) then
      do ichunk=1,ubound(chunkset%chunks,1)
        call chunkset%chunks(ichunk)%free(error)
        ! if (error) continue
      enddo ! ichunk
      chunkset%n = 0
      if (associated(chunkset%chunks))  deallocate(chunkset%chunks)
      chunkset%allocated = code_pointer_null
    endif
  end subroutine free_chunkset
  !
  subroutine nullify_chunkset(chunkset,error)
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    class(chunkset_t), intent(inout) :: chunkset
    logical,           intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='NULLIFY>CHUNKSET'
    !
    call mrtcal_message(seve%t,rname,'Welcome')
    !
    if (chunkset%allocated.eq.code_pointer_associated) then
      chunkset%n = 0
      chunkset%chunks => null()
      chunkset%allocated = code_pointer_null
      !
    elseif (chunkset%allocated.eq.code_pointer_allocated) then
      call mrtcal_message(seve%e,rname,'Attempt to nullify an allocated pointer')
      error = .true.
      return
    endif
  end subroutine nullify_chunkset
  !
  subroutine chunkset_consistency(c1,caller,c2,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(chunkset_t), intent(in)    :: c1
    character(len=*),  intent(in)    :: caller  ! Calling routine name
    type(chunkset_t),  intent(in)    :: c2
    logical,           intent(inout) :: error
    ! Local
    integer(kind=4) :: ichunk
    character(len=message_length) :: mess
    !
    if (c1%n.ne.c2%n) then
      write(mess,'(A,I0,1X,I0)')  &
        'Inconsistent number of chunks per set: ',c1%n,c2%n
      call mrtcal_message(seve%e,caller,mess)
      error = .true.
      return
    endif
    !
    do ichunk=1,c1%n
      if (c1%chunks(ichunk)%ndata.ne.c2%chunks(ichunk)%ndata) then
        write(mess,'(A,I0,1X,I0)')  'Inconsistent number of channels: ', &
          c1%chunks(ichunk)%ndata,c2%chunks(ichunk)%ndata
        call mrtcal_message(seve%e,caller,mess)
        error = .true.
        return
      endif
    enddo
    !
  end subroutine chunkset_consistency
  !
  subroutine chunkset_init_data(chunkset,v,w,c,error)
    !-------------------------------------------------------------------
    ! Initialize the chunk data from the input values
    !-------------------------------------------------------------------
    class(chunkset_t), intent(inout) :: chunkset
    real(kind=4),      intent(in)    :: v      ! Data value (duplicated to all channels)
    real(kind=4),      intent(in)    :: w      ! Weight (duplicated to all channels)
    real(kind=4),      intent(in)    :: c      ! Continuum value
    logical,           intent(inout) :: error
    ! Local
    integer(kind=4) :: ichunk
    character(len=*), parameter :: rname='CHUNKSET>INIT>DATA'
    !
    call mrtcal_message(seve%t,rname,'Welcome')
    !
    do ichunk=1,chunkset%n
      call chunkset%chunks(ichunk)%init_data(v,w,c,error)
      if (error) return
    enddo ! ichunk
  end subroutine chunkset_init_data
  !
  subroutine clone_chunkset(ou,in,doheader,error)
    !-------------------------------------------------------------------
    !  Clone a chunkset structure.
    !
    !  The chunks in the chunkset are ALLOCATED so that the full structure
    ! clones exactly the input one.
    !  Nothing is done for the data and headers (not copied, not
    ! initialized e.g. to 0).
    !-------------------------------------------------------------------
    class(chunkset_t), intent(inout) :: ou        !
    type(chunkset_t),  intent(in)    :: in        !
    logical,           intent(in)    :: doheader  ! Also clone the headers?
    logical,           intent(inout) :: error     !
    ! Local
    integer(kind=4) :: ichunk
    !
    call ou%reallocate(in%n,error)
    if (error) return
    !
    do ichunk=1,in%n
      call ou%chunks(ichunk)%clone(in%chunks(ichunk),doheader,error)
      if (error) return
    enddo
  end subroutine clone_chunkset
end module mrtcal_chunkset_types
!
