!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! This file starts with the modules of definitions of the array types
! ordered by rank (1D, 2D, and 3D). At the end, it contains the
! cubetools_array_types module that gathers all the known array types.
!
! The unblank method is meaningful only for 1d arrays.  We could want to
! have 2d and 3d arrays that contracts as 1d arrays but that would require
! quite some memory duplication.
!
! *** JP: The SET and ISBLANKED, HASBLANK method should be generalized.
!
! *** JP: This one should be recoded in object oriented style with a
! *** JP: array_1d_t primitive that would be extended into real_1d_t,
! *** JP: cplx_1d_t, etc.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! long(kind=long_k) 1D case
!
module cubetools_long_1d_types
  use cubetools_parameters
  use cubetools_messaging
  !
  public :: long_1d_t
  private
  !
  type long_1d_t
     character(len=name_l), private :: name = strg_unk               ! Array name
     integer(kind=indx_k),  public  :: n = 0                         ! Array size
     integer(kind=long_k),  public, pointer :: val(:) => null()      ! Array address
     integer(kind=code_k),  private :: pointeris = code_pointer_null ! Null, allocated, or associated?
   contains
     procedure, public :: reallocate          => cubetools_long_1d_reallocate
     procedure, public :: prepare_association => cubetools_long_1d_prepare_association
     procedure, public :: free                => cubetools_long_1d_free
     procedure, public :: set                 => cubetools_long_1d_set
     procedure, public :: get                 => cubetools_long_1d_get
     procedure, public :: point_to            => cubetools_long_1d_point_to
     procedure, public :: list                => cubetools_long_1d_list
     procedure, public :: unallocated         => cubetools_long_1d_unallocated
     final :: cubetools_long_1d_final
  end type long_1d_t
  !
contains
  !
  subroutine cubetools_long_1d_reallocate(array,name,n,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(long_1d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: n
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>LONG>1D>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (n.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (array%n.eq.n) then
          write(mess,'(a,a,i0)')  &
               name,' long_1d already allocated at the right size: ',n
          call cubetools_message(toolseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' long_1d already allocated but with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_long_1d_free(array)
          alloc = .true.
       endif
    else
       ! array%val is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(array%val(n),stat=ier)
       if (failed_allocate(rname,trim(name)//' long_1d',ier,error)) return
    endif
    ! Allocation success => array%pointeris may be updated
    array%n = n
    array%pointeris = code_pointer_allocated
  end subroutine cubetools_long_1d_reallocate
  !
  subroutine cubetools_long_1d_prepare_association(array,name,n,error)
    !----------------------------------------------------------------------
    ! Prepare for the next reassociation
    !----------------------------------------------------------------------
    class(long_1d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: n
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='LONG>1D>PREPARE>ASSOCIATION'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (n.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call array%free()
    ! Association success => image%code_pointer may be updated
    array%name = name
    array%n = n
    array%pointeris = code_pointer_null
  end subroutine cubetools_long_1d_prepare_association
  !
  subroutine cubetools_long_1d_free(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(long_1d_t), intent(inout) :: array
    !
    character(len=*), parameter :: rname='ARRAY>LONG>1D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       if (associated(array%val)) deallocate(array%val)
    else
       array%val => null()
    endif
    array%name = strg_unk
    array%n = 0
    array%pointeris = code_pointer_null
  end subroutine cubetools_long_1d_free
  !
  subroutine cubetools_long_1d_final(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(long_1d_t), intent(inout) :: array
    !
    call cubetools_long_1d_free(array)
  end subroutine cubetools_long_1d_final
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_long_1d_set(array,value,error)
    !----------------------------------------------------------------------
    ! Set all array elements to value
    !----------------------------------------------------------------------
    class(long_1d_t),     intent(in)    :: array
    integer(kind=long_k), intent(in)    :: value
    logical,              intent(inout) :: error
    !
    integer(kind=indx_k) :: i
    character(len=*), parameter :: rname='ARRAY>LONG>1D>SET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    do i=1,array%n
       array%val(i) = value
    enddo ! i
  end subroutine cubetools_long_1d_set
  !
  subroutine cubetools_long_1d_get(ou,in,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(long_1d_t),             intent(inout) :: ou
    integer(kind=long_k), target, intent(in)    :: in(:)
    logical,                      intent(inout) :: error
    !
    integer(kind=indx_k) :: i,nin,nou
    character(len=*), parameter :: rname='ARRAY>LONG>1D>GET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    nin = ubound(in,1)
    if (ou%pointeris.eq.code_pointer_allocated) then
       nou = ubound(ou%val,1)
       if (nin.gt.nou) then
          call cubetools_message(seve%e,rname,'input array larger than the allocated '//trim(ou%name)//' one')
          error = .true.
          return
       else if (nin.lt.nou) then
          ou%n = nin
       else
          ! Same dimensions => Do nothing
       endif
       do i=1,ou%n
          ou%val(i) = in(i)
       enddo ! i
    else
       ou%val => in
       ou%n = nin
       ou%pointeris = code_pointer_associated
    endif
  end subroutine cubetools_long_1d_get
  !
  subroutine cubetools_long_1d_point_to(ou,in,ifirst,ilast,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(long_1d_t),     intent(inout) :: ou
    type(long_1d_t),      intent(in)    :: in
    integer(kind=indx_k), intent(in)    :: ifirst
    integer(kind=indx_k), intent(in)    :: ilast
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>LONG>1D>POINT_TO'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (ou%pointeris.eq.code_pointer_allocated) then
       call cubetools_message(seve%e,rname,'Programming error')
       call cubetools_message(seve%e,rname,'Cannot associate the '//trim(ou%name)//' pointer as it is allocated')
       error = .true.
       return
    else
       ou%val => in%val(ifirst:ilast)
       ou%n = ilast-ifirst+1
       ou%pointeris = code_pointer_associated
    endif
  end subroutine cubetools_long_1d_point_to
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_long_1d_list(array,error)
    !----------------------------------------------------------------------
    ! Debug subroutine
    !----------------------------------------------------------------------
    class(long_1d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>LONG>1D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    print *,array%name,' long_1d ',array%n,array%pointeris
  end subroutine cubetools_long_1d_list
  !
  function cubetools_long_1d_unallocated(array,error) result(unallocated)
    !----------------------------------------------------------------------
    ! Debug function. Should not be used in standard code.
    !----------------------------------------------------------------------
    class(long_1d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    logical                         :: unallocated
    !
    character(len=*), parameter :: rname='ARRAY>LONG>1D>UNALLOCATED'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    unallocated = array%pointeris.eq.code_pointer_null
    if (unallocated) then
       call cubetools_message(seve%e,rname,'Unallocated '//trim(array%name)//' long_1d array')
       error = .true.
       return
    endif
  end function cubetools_long_1d_unallocated
end module cubetools_long_1d_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! integer(kind=inte_k) 1D case
!
module cubetools_inte_1d_types
  use cubetools_parameters
  use cubetools_messaging
  !
  public :: inte_1d_t
  private
  !
  type inte_1d_t
     character(len=name_l), private :: name = strg_unk               ! Array name
     integer(kind=indx_k),  public  :: n = 0                         ! Array size
     integer(kind=inte_k),  public, pointer :: val(:) => null()      ! Array address
     integer(kind=code_k),  private :: pointeris = code_pointer_null ! Null, allocated, or associated?
   contains
     procedure, public :: reallocate          => cubetools_inte_1d_reallocate
     procedure, public :: prepare_association => cubetools_inte_1d_prepare_association
     procedure, public :: free                => cubetools_inte_1d_free
     procedure, public :: set                 => cubetools_inte_1d_set
     procedure, public :: get                 => cubetools_inte_1d_get
     procedure, public :: point_to            => cubetools_inte_1d_point_to
     procedure, public :: list                => cubetools_inte_1d_list
     procedure, public :: unallocated         => cubetools_inte_1d_unallocated
     final :: cubetools_inte_1d_final
  end type inte_1d_t
  !
contains
  !
  subroutine cubetools_inte_1d_reallocate(array,name,n,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(inte_1d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: n
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>LONG>1D>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (n.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (array%n.eq.n) then
          write(mess,'(a,a,i0)')  &
               name,' inte_1d already allocated at the right size: ',n
          call cubetools_message(toolseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' inte_1d already allocated but with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_inte_1d_free(array)
          alloc = .true.
       endif
    else
       ! array%val is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(array%val(n),stat=ier)
       if (failed_allocate(rname,trim(name)//' inte_1d',ier,error)) return
    endif
    ! Allocation success => array%pointeris may be updated
    array%n = n
    array%pointeris = code_pointer_allocated
  end subroutine cubetools_inte_1d_reallocate
  !
  subroutine cubetools_inte_1d_prepare_association(array,name,n,error)
    !----------------------------------------------------------------------
    ! Prepare for the next reassociation
    !----------------------------------------------------------------------
    class(inte_1d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: n
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='LONG>1D>PREPARE>ASSOCIATION'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (n.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call array%free()
    ! Association success => image%code_pointer may be updated
    array%name = name
    array%n = n
    array%pointeris = code_pointer_null
  end subroutine cubetools_inte_1d_prepare_association
  !
  subroutine cubetools_inte_1d_free(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(inte_1d_t), intent(inout) :: array
    !
    character(len=*), parameter :: rname='ARRAY>LONG>1D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       if (associated(array%val)) deallocate(array%val)
    else
       array%val => null()
    endif
    array%name = strg_unk
    array%n = 0
    array%pointeris = code_pointer_null
  end subroutine cubetools_inte_1d_free
  !
  subroutine cubetools_inte_1d_final(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(inte_1d_t), intent(inout) :: array
    !
    call cubetools_inte_1d_free(array)
  end subroutine cubetools_inte_1d_final
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_inte_1d_set(array,value,error)
    !----------------------------------------------------------------------
    ! Set all array elements to value
    !----------------------------------------------------------------------
    class(inte_1d_t),     intent(in)    :: array
    integer(kind=inte_k), intent(in)    :: value
    logical,              intent(inout) :: error
    !
    integer(kind=indx_k) :: i
    character(len=*), parameter :: rname='ARRAY>LONG>1D>SET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    do i=1,array%n
       array%val(i) = value
    enddo ! i
  end subroutine cubetools_inte_1d_set
  !
  subroutine cubetools_inte_1d_get(ou,in,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(inte_1d_t),             intent(inout) :: ou
    integer(kind=inte_k), target, intent(in)    :: in(:)
    logical,                      intent(inout) :: error
    !
    integer(kind=indx_k) :: i,nin,nou
    character(len=*), parameter :: rname='ARRAY>LONG>1D>GET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    nin = ubound(in,1)
    if (ou%pointeris.eq.code_pointer_allocated) then
       nou = ubound(ou%val,1)
       if (nin.gt.nou) then
          call cubetools_message(seve%e,rname,'input array larger than the allocated '//trim(ou%name)//' one')
          error = .true.
          return
       else if (nin.lt.nou) then
          ou%n = nin
       else
          ! Same dimensions => Do nothing
       endif
       do i=1,ou%n
          ou%val(i) = in(i)
       enddo ! i
    else
       ou%val => in
       ou%n = nin
       ou%pointeris = code_pointer_associated
    endif
  end subroutine cubetools_inte_1d_get
  !
  subroutine cubetools_inte_1d_point_to(ou,in,ifirst,ilast,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(inte_1d_t),     intent(inout) :: ou
    type(inte_1d_t),      intent(in)    :: in
    integer(kind=indx_k), intent(in)    :: ifirst
    integer(kind=indx_k), intent(in)    :: ilast
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>LONG>1D>POINT_TO'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (ou%pointeris.eq.code_pointer_allocated) then
       call cubetools_message(seve%e,rname,'Programming error')
       call cubetools_message(seve%e,rname,'Cannot associate the '//trim(ou%name)//' pointer as it is allocated')
       error = .true.
       return
    else
       ou%val => in%val(ifirst:ilast)
       ou%n = ilast-ifirst+1
       ou%pointeris = code_pointer_associated
    endif
  end subroutine cubetools_inte_1d_point_to
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_inte_1d_list(array,error)
    !----------------------------------------------------------------------
    ! Debug subroutine
    !----------------------------------------------------------------------
    class(inte_1d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>LONG>1D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    print *,array%name,' inte_1d ',array%n,array%pointeris
  end subroutine cubetools_inte_1d_list
  !
  function cubetools_inte_1d_unallocated(array,error) result(unallocated)
    !----------------------------------------------------------------------
    ! Debug function. Should not be used in standard code.
    !----------------------------------------------------------------------
    class(inte_1d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    logical                         :: unallocated
    !
    character(len=*), parameter :: rname='ARRAY>LONG>1D>UNALLOCATED'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    unallocated = array%pointeris.eq.code_pointer_null
    if (unallocated) then
       call cubetools_message(seve%e,rname,'Unallocated '//trim(array%name)//' inte_1d array')
       error = .true.
       return
    endif
  end function cubetools_inte_1d_unallocated
end module cubetools_inte_1d_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! real(kind=real_k) 1D case
!
module cubetools_real_1d_types
  use cubetools_parameters
  use cubetools_messaging
  !
  public :: real_1d_t
  private
  !
  type real_1d_t
     character(len=name_l), private :: name = strg_unk               ! Array name
     integer(kind=indx_k),  public  :: n = 0                         ! Array size
     real(kind=real_k),     public, pointer :: val(:) => null()      ! Array address
     integer(kind=code_k),  private :: pointeris = code_pointer_null ! Null, allocated, or associated?
   contains
     procedure, public :: reallocate          => cubetools_real_1d_reallocate
     procedure, public :: prepare_association => cubetools_real_1d_prepare_association
     procedure, public :: free                => cubetools_real_1d_free
     procedure, public :: set                 => cubetools_real_1d_set
     procedure, public :: get                 => cubetools_real_1d_get
     procedure, public :: point_to            => cubetools_real_1d_point_to
     procedure, public :: isblanked           => cubetools_real_1d_isblanked
     procedure, public :: hasblank            => cubetools_real_1d_hasblank
     procedure, public :: unblank             => cubetools_real_1d_unblank
     procedure, public :: unblank_as          => cubetools_real_1d_unblank_as
     procedure, public :: list                => cubetools_real_1d_list
     procedure, public :: associated          => cubetools_real_1d_associated
     procedure, public :: unallocated         => cubetools_real_1d_unallocated
     final :: cubetools_real_1d_final
  end type real_1d_t
  !
contains
  !
  subroutine cubetools_real_1d_reallocate(array,name,n,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(real_1d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: n
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>REAL>1D>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (n.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (array%n.eq.n) then
          write(mess,'(a,a,i0)')  &
               name,' real_1d already allocated at the right size: ',n
          call cubetools_message(toolseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' real_1d already allocated but with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_real_1d_free(array)
          alloc = .true.
       endif
    else
       ! array%val is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(array%val(n),stat=ier)
       if (failed_allocate(rname,trim(name)//' real_1d',ier,error)) return
    endif
    ! Allocation success => array%pointeris may be updated
    array%n = n
    array%pointeris = code_pointer_allocated
  end subroutine cubetools_real_1d_reallocate
  !
  subroutine cubetools_real_1d_prepare_association(array,name,n,error)
    !----------------------------------------------------------------------
    ! Prepare for the next reassociation
    !----------------------------------------------------------------------
    class(real_1d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: n
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='REAL>1D>PREPARE>ASSOCIATION'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (n.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call array%free()
    ! Association success => image%code_pointer may be updated
    array%name = name
    array%n = n
    array%pointeris = code_pointer_null
  end subroutine cubetools_real_1d_prepare_association
  !
  subroutine cubetools_real_1d_free(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(real_1d_t), intent(inout) :: array
    !
    character(len=*), parameter :: rname='ARRAY>REAL>1D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       if (associated(array%val)) deallocate(array%val)
    else
       array%val => null()
    endif
    array%name = strg_unk
    array%n = 0
    array%pointeris = code_pointer_null
  end subroutine cubetools_real_1d_free
  !
  subroutine cubetools_real_1d_final(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(real_1d_t), intent(inout) :: array
    !
    call cubetools_real_1d_free(array)
  end subroutine cubetools_real_1d_final
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_real_1d_set(array,value,error)
    !----------------------------------------------------------------------
    ! Set all array elements to value
    !----------------------------------------------------------------------
    class(real_1d_t),  intent(in)    :: array
    real(kind=real_k), intent(in)    :: value
    logical,           intent(inout) :: error
    !
    integer(kind=indx_k) :: i
    character(len=*), parameter :: rname='ARRAY>REAL>1D>SET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    do i=1,array%n
       array%val(i) = value
    enddo ! i
  end subroutine cubetools_real_1d_set
  !
  subroutine cubetools_real_1d_get(ou,in,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(real_1d_t),          intent(inout) :: ou
    real(kind=real_k), target, intent(in)    :: in(:)
    logical,                   intent(inout) :: error
    !
    integer(kind=indx_k) :: i,nin,nou
    character(len=*), parameter :: rname='ARRAY>REAL>1D>GET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    nin = ubound(in,1)
    if (ou%pointeris.eq.code_pointer_allocated) then
       nou = ubound(ou%val,1)
       if (nin.gt.nou) then
          call cubetools_message(seve%e,rname,'input array larger than the allocated '//trim(ou%name)//' one')
          error = .true.
          return
       else if (nin.lt.nou) then
          ou%n = nin
       else
          ! Same dimensions => Do nothing
       endif
       do i=1,ou%n
          ou%val(i) = in(i)
       enddo ! i
    else
       ou%val => in
       ou%n = nin
       ou%pointeris = code_pointer_associated
    endif
  end subroutine cubetools_real_1d_get
  !
  subroutine cubetools_real_1d_point_to(ou,in,ifirst,ilast,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(real_1d_t),     intent(inout) :: ou
    type(real_1d_t),      intent(in)    :: in
    integer(kind=indx_k), intent(in)    :: ifirst
    integer(kind=indx_k), intent(in)    :: ilast
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>REAL>1D>POINT_TO'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (ou%pointeris.eq.code_pointer_allocated) then
       call cubetools_message(seve%e,rname,'Programming error')
       call cubetools_message(seve%e,rname,'Cannot associate the '//trim(ou%name)//' pointer as it is allocated')
       error = .true.
       return
    else
       ou%val => in%val(ifirst:ilast)
       ou%n = ilast-ifirst+1
       ou%pointeris = code_pointer_associated
    endif
  end subroutine cubetools_real_1d_point_to
  !
  !------------------------------------------------------------------------
  !
  function cubetools_real_1d_isblanked(array) result(isblanked)
    use cubetools_nan
    !-------------------------------------------------------------------
    ! The standard case is that the array has mostly unblanked values.
    ! In this case, the call to this function is relatively inexpensive
    !-------------------------------------------------------------------
    class(real_1d_t), intent(in) :: array
    !
    logical :: isblanked
    integer(kind=entr_k) :: i
    character(len=*), parameter :: rname='ARRAY>REAL>1D>ISBLANKED'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    isblanked = .true.
    do i=1,array%n
       if (.not.ieee_is_nan(array%val(i))) then
          isblanked = .false.
          return
       endif
    enddo ! i
  end function cubetools_real_1d_isblanked
  !
  function cubetools_real_1d_hasblank(array) result(hasblank)
    use cubetools_nan
    !-------------------------------------------------------------------
    ! This one costs much when the array is completely valid!
    !-------------------------------------------------------------------
    class(real_1d_t), intent(in) :: array
    !
    logical :: hasblank
    integer(kind=entr_k) :: i
    character(len=*), parameter :: rname='ARRAY>REAL>1D>HASBLANK'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    hasblank = .false.
    do i=1,array%n
       if (ieee_is_nan(array%val(i))) then
          hasblank = .true.
          return
       endif
    enddo ! i
  end function cubetools_real_1d_hasblank
  !
  subroutine cubetools_real_1d_unblank(ou,in,error)
    use cubetools_nan
    !----------------------------------------------------------------------
    ! Return a contracted version of an array by removing its blanking
    ! values. The allocated but unused part of the array is set to NaN.
    !----------------------------------------------------------------------
    class(real_1d_t), intent(inout) :: ou
    type(real_1d_t),  intent(in)    :: in
    logical,          intent(inout) :: error
    !
    integer(kind=chan_k) :: i,j
    character(len=*), parameter :: rname='ARRAY>REAL>1D>UNBLANK'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    j = 1
    do i=1,in%n
       if (.not.ieee_is_nan(in%val(i))) then
          ou%val(j) = in%val(i)
          j = j+1
       endif
    enddo ! i
    do i=j,ou%n
       ou%val(i) = gr4nan
    enddo ! i
    ou%n = j-1
  end subroutine cubetools_real_1d_unblank
  !
  subroutine cubetools_real_1d_unblank_as(ou,in,ref,error)
    use cubetools_nan
    !----------------------------------------------------------------------
    ! Return a contracted version of an array by removing its values where
    ! the reference array is blanked. The allocated but unused part of the
    ! array is set to NaN.
    !----------------------------------------------------------------------
    class(real_1d_t), intent(inout) :: ou
    type(real_1d_t),  intent(in)    :: in
    type(real_1d_t),  intent(in)    :: ref
    logical,          intent(inout) :: error
    !
    integer(kind=chan_k) :: i,j
    character(len=*), parameter :: rname='ARRAY>REAL>1D>UNBLANK>AS'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    j = 1
    do i=1,in%n
       if (.not.ieee_is_nan(ref%val(i))) then
          ou%val(j) = in%val(i)
          j = j+1
       endif
    enddo ! i
    do i=j,ou%n
       ou%val(i) = gr4nan
    enddo ! i
    ou%n = j-1
  end subroutine cubetools_real_1d_unblank_as
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_real_1d_list(array,error)
    !----------------------------------------------------------------------
    ! Debug subroutine
    !----------------------------------------------------------------------
    class(real_1d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>REAL>1D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    print *,array%name,' real_1d ',array%n,array%pointeris
  end subroutine cubetools_real_1d_list
  !
  function cubetools_real_1d_associated(array) result(associated)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(real_1d_t), intent(in) :: array
    logical                      :: associated
    !
    associated = array%pointeris.ne.code_pointer_null
  end function cubetools_real_1d_associated
  !
  function cubetools_real_1d_unallocated(array,error) result(unallocated)
    !----------------------------------------------------------------------
    ! Debug function. Should not be used in standard code.
    !----------------------------------------------------------------------
    class(real_1d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    logical                         :: unallocated
    !
    character(len=*), parameter :: rname='ARRAY>REAL>1D>UNALLOCATED'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    unallocated = array%pointeris.eq.code_pointer_null
    if (unallocated) then
       call cubetools_message(seve%e,rname,'Unallocated '//trim(array%name)//' real_1d array')
       error = .true.
       return
    endif
  end function cubetools_real_1d_unallocated
end module cubetools_real_1d_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! real(kind=dble_k) 1D case
!
module cubetools_dble_1d_types
  use cubetools_parameters
  use cubetools_messaging
  !
  public :: dble_1d_t
  private
  !
  type dble_1d_t
     character(len=name_l), private :: name = strg_unk               ! Array name
     integer(kind=indx_k),  public  :: n = 0                         ! Array size
     real(kind=dble_k),     public, pointer :: val(:) => null()      ! Array address
     integer(kind=code_k),  private :: pointeris = code_pointer_null ! Null, allocated, or associated?
   contains
     procedure, public :: reallocate          => cubetools_dble_1d_reallocate
     procedure, public :: prepare_association => cubetools_dble_1d_prepare_association
     procedure, public :: free                => cubetools_dble_1d_free
     procedure, public :: set                 => cubetools_dble_1d_set
     procedure, public :: get                 => cubetools_dble_1d_get
     procedure, public :: point_to            => cubetools_dble_1d_point_to
     procedure, public :: isblanked           => cubetools_dble_1d_isblanked
     procedure, public :: hasblank            => cubetools_dble_1d_hasblank
     procedure, public :: unblank             => cubetools_dble_1d_unblank
     procedure, public :: unblank_as          => cubetools_dble_1d_unblank_as
     procedure, public :: list                => cubetools_dble_1d_list
     procedure, public :: associated          => cubetools_dble_1d_associated
     procedure, public :: unallocated         => cubetools_dble_1d_unallocated
     final :: cubetools_dble_1d_final
  end type dble_1d_t
  !
contains
  !
  subroutine cubetools_dble_1d_reallocate(array,name,n,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(dble_1d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: n
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>DBLE>1D>DBLELOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (n.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (array%n.eq.n) then
          write(mess,'(a,a,i0)')  &
               name,' dble_1d already allocated at the right size: ',n
          call cubetools_message(toolseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' dble_1d already allocated but with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_dble_1d_free(array)
          alloc = .true.
       endif
    else
       ! array%val is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(array%val(n),stat=ier)
       if (failed_allocate(rname,trim(name)//' dble_1d',ier,error)) return
    endif
    ! Allocation success => array%pointeris may be updated
    array%n = n
    array%pointeris = code_pointer_allocated
  end subroutine cubetools_dble_1d_reallocate
  !
  subroutine cubetools_dble_1d_prepare_association(array,name,n,error)
    !----------------------------------------------------------------------
    ! Prepare for the next reassociation
    !----------------------------------------------------------------------
    class(dble_1d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: n
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='DBLE>1D>PREPARE>ASSOCIATION'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (n.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call array%free()
    ! Association success => image%code_pointer may be updated
    array%name = name
    array%n = n
    array%pointeris = code_pointer_null
  end subroutine cubetools_dble_1d_prepare_association
  !
  subroutine cubetools_dble_1d_free(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(dble_1d_t), intent(inout) :: array
    !
    character(len=*), parameter :: rname='ARRAY>DBLE>1D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       if (associated(array%val)) deallocate(array%val)
    else
       array%val => null()
    endif
    array%name = strg_unk
    array%n = 0
    array%pointeris = code_pointer_null
  end subroutine cubetools_dble_1d_free
  !
  subroutine cubetools_dble_1d_final(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(dble_1d_t), intent(inout) :: array
    !
    call cubetools_dble_1d_free(array)
  end subroutine cubetools_dble_1d_final
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_dble_1d_set(array,value,error)
    !----------------------------------------------------------------------
    ! Set all array elements to value
    !----------------------------------------------------------------------
    class(dble_1d_t),  intent(in)    :: array
    real(kind=dble_k), intent(in)    :: value
    logical,           intent(inout) :: error
    !
    integer(kind=indx_k) :: i
    character(len=*), parameter :: rname='ARRAY>DBLE>1D>SET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    do i=1,array%n
       array%val(i) = value
    enddo ! i
  end subroutine cubetools_dble_1d_set
  !
  subroutine cubetools_dble_1d_get(ou,in,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(dble_1d_t),          intent(inout) :: ou
    real(kind=dble_k), target, intent(in)    :: in(:)
    logical,                   intent(inout) :: error
    !
    integer(kind=indx_k) :: i,nin,nou
    character(len=*), parameter :: rname='ARRAY>DBLE>1D>GET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    nin = ubound(in,1)
    if (ou%pointeris.eq.code_pointer_allocated) then
       nou = ubound(ou%val,1)
       if (nin.gt.nou) then
          call cubetools_message(seve%e,rname,'input array larger than the allocated '//trim(ou%name)//' one')
          error = .true.
          return
       else if (nin.lt.nou) then
          ou%n = nin
       else
          ! Same dimensions => Do nothing
       endif
       do i=1,ou%n
          ou%val(i) = in(i)
       enddo ! i
    else
       ou%val => in
       ou%n = nin
       ou%pointeris = code_pointer_associated
    endif
  end subroutine cubetools_dble_1d_get
  !
  subroutine cubetools_dble_1d_point_to(ou,in,ifirst,ilast,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(dble_1d_t),     intent(inout) :: ou
    type(dble_1d_t),      intent(in)    :: in
    integer(kind=indx_k), intent(in)    :: ifirst
    integer(kind=indx_k), intent(in)    :: ilast
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>DBLE>1D>POINT_TO'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (ou%pointeris.eq.code_pointer_allocated) then
       call cubetools_message(seve%e,rname,'Programming error')
       call cubetools_message(seve%e,rname,'Cannot associate the '//trim(ou%name)//' pointer as it is allocated')
       error = .true.
       return
    else
       ou%val => in%val(ifirst:ilast)
       ou%n = ilast-ifirst+1
       ou%pointeris = code_pointer_associated
    endif
  end subroutine cubetools_dble_1d_point_to
  !
  !------------------------------------------------------------------------
  !
  function cubetools_dble_1d_isblanked(array) result(isblanked)
    use cubetools_nan
    !-------------------------------------------------------------------
    ! The standard case is that the array has mostly unblanked values.
    ! In this case, the call to this function is relatively inexpensive
    !-------------------------------------------------------------------
    class(dble_1d_t), intent(in) :: array
    !
    logical :: isblanked
    integer(kind=entr_k) :: i
    character(len=*), parameter :: rname='ARRAY>DBLE>1D>ISBLANKED'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    isblanked = .true.
    do i=1,array%n
       if (.not.ieee_is_nan(array%val(i))) then
          isblanked = .false.
          return
       endif
    enddo ! i
  end function cubetools_dble_1d_isblanked
  !
  function cubetools_dble_1d_hasblank(array) result(hasblank)
    use cubetools_nan
    !-------------------------------------------------------------------
    ! This one costs much when the array is completely valid!
    !-------------------------------------------------------------------
    class(dble_1d_t), intent(in) :: array
    !
    logical :: hasblank
    integer(kind=entr_k) :: i
    character(len=*), parameter :: rname='ARRAY>DBLE>1D>HASBLANK'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    hasblank = .false.
    do i=1,array%n
       if (ieee_is_nan(array%val(i))) then
          hasblank = .true.
          return
       endif
    enddo ! i
  end function cubetools_dble_1d_hasblank
  !
  subroutine cubetools_dble_1d_unblank(ou,in,error)
    use cubetools_nan
    !----------------------------------------------------------------------
    ! Return a contracted version of an array by removing its blanking
    ! values. The allocated but unused part of the array is set to NaN.
    !----------------------------------------------------------------------
    class(dble_1d_t), intent(inout) :: ou
    type(dble_1d_t),  intent(in)    :: in
    logical,          intent(inout) :: error
    !
    integer(kind=chan_k) :: i,j
    character(len=*), parameter :: rname='ARRAY>DBLE>1D>UNBLANK'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    j = 1
    do i=1,in%n
       if (.not.ieee_is_nan(in%val(i))) then
          ou%val(j) = in%val(i)
          j = j+1
       endif
    enddo ! i
    do i=j,ou%n
       ou%val(i) = gr8nan
    enddo ! i
    ou%n = j-1
  end subroutine cubetools_dble_1d_unblank
  !
  subroutine cubetools_dble_1d_unblank_as(ou,in,ref,error)
    use cubetools_nan
    use cubetools_real_1d_types
    !----------------------------------------------------------------------
    ! Return a contracted version of an array by removing its values where
    ! the reference array is blanked. The allocated but unused part of the
    ! array is set to NaN.
    ! *** JP: The fact that we use the cubetools_real_1d_types suggests that
    ! *** JP: this method is ill-placed. Unclear though.
    !----------------------------------------------------------------------
    class(dble_1d_t), intent(inout) :: ou
    type(dble_1d_t),  intent(in)    :: in
    type(real_1d_t),  intent(in)    :: ref
    logical,          intent(inout) :: error
    !
    integer(kind=chan_k) :: i,j
    character(len=*), parameter :: rname='ARRAY>DBLE>1D>UNBLANK>AS'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    j = 1
    do i=1,in%n
       if (.not.ieee_is_nan(ref%val(i))) then
          ou%val(j) = in%val(i)
          j = j+1
       endif
    enddo ! i
    do i=j,ou%n
       ou%val(i) = gr8nan
    enddo ! i
    ou%n = j-1
  end subroutine cubetools_dble_1d_unblank_as
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_dble_1d_list(array,error)
    !----------------------------------------------------------------------
    ! Debug subroutine
    !----------------------------------------------------------------------
    class(dble_1d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>DBLE>1D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    print *,array%name,' dble_1d ',array%n,array%pointeris
  end subroutine cubetools_dble_1d_list
  !
  function cubetools_dble_1d_associated(array) result(associated)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(dble_1d_t), intent(in) :: array
    logical                      :: associated
    !
    associated = array%pointeris.ne.code_pointer_null
  end function cubetools_dble_1d_associated
  !
  function cubetools_dble_1d_unallocated(array,error) result(unallocated)
    !----------------------------------------------------------------------
    ! Debug function. Should not be used in standard code.
    !----------------------------------------------------------------------
    class(dble_1d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    logical                         :: unallocated
    !
    character(len=*), parameter :: rname='ARRAY>DBLE>1D>UNALLOCATED'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    unallocated = array%pointeris.eq.code_pointer_null
    if (unallocated) then
       call cubetools_message(seve%e,rname,'Unallocated '//trim(array%name)//' dble_1d array')
       error = .true.
       return
    endif
  end function cubetools_dble_1d_unallocated
end module cubetools_dble_1d_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! complex(kind=real_k) 1D case
!
module cubetools_cplx_1d_types
  use cubetools_parameters
  use cubetools_messaging
  !
  public :: cplx_1d_t
  private
  !
  type cplx_1d_t
     character(len=name_l) :: name = strg_unk               ! Array name
     integer(kind=indx_k)  :: n = 0                         ! Array size
     complex(kind=real_k), pointer :: val(:) => null()      ! Array address
     integer(kind=code_k)  :: pointeris = code_pointer_null ! Null, allocated, or associated?
   contains
     procedure, public :: reallocate  => cubetools_cplx_1d_reallocate
     procedure, public :: free        => cubetools_cplx_1d_free
     procedure, public :: list        => cubetools_cplx_1d_list
     final :: cubetools_cplx_1d_final
  end type cplx_1d_t
  !
contains
  !
  subroutine cubetools_cplx_1d_reallocate(array,name,n,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(cplx_1d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: n
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>CPLX>1D>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (n.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (array%n.eq.n) then
          write(mess,'(a,a,i0)')  &
               name,' cplx_1d already allocated at the right size: ',n
          call cubetools_message(toolseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' cplx_1d already allocated but with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_cplx_1d_free(array)
          alloc = .true.
       endif
    else
       ! array%val is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(array%val(n),stat=ier)
       if (failed_allocate(rname,trim(name)//' cplx_1d',ier,error)) return
    endif
    ! Allocation success => array%pointeris may be updated
    array%n = n
    array%pointeris = code_pointer_allocated
  end subroutine cubetools_cplx_1d_reallocate
  !
  subroutine cubetools_cplx_1d_free(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(cplx_1d_t), intent(inout) :: array
    !
    character(len=*), parameter :: rname='ARRAY>CPLX>1D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       if (associated(array%val)) deallocate(array%val)
    else
       array%val => null()
    endif
    array%n = 0
    array%pointeris = code_pointer_null
  end subroutine cubetools_cplx_1d_free
  !
  subroutine cubetools_cplx_1d_final(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cplx_1d_t), intent(inout) :: array
    !
    call cubetools_cplx_1d_free(array)
  end subroutine cubetools_cplx_1d_final
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_cplx_1d_list(array,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(cplx_1d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>CPLX>1D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    print *,array%name,' cplx_1d ',array%n,array%pointeris
  end subroutine cubetools_cplx_1d_list
end module cubetools_cplx_1d_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! character(kind=strg_l) 1D case
!
module cubetools_strg_1d_types
  use cubetools_parameters
  use cubetools_messaging
  !
  public :: strg_1d_t
  private
  !
  type strg_1d_t
     character(len=name_l) :: name = strg_unk               ! Array name
     integer(kind=indx_k)  :: n = 0                         ! Array size
     character(len=strg_l), pointer :: val(:) => null()     ! Array address
     integer(kind=code_k)  :: pointeris = code_pointer_null ! Null, allocated, or associated?
   contains
     procedure, public :: reallocate  => cubetools_strg_1d_reallocate
     procedure, public :: free        => cubetools_strg_1d_free
     procedure, public :: list        => cubetools_strg_1d_list
     final :: cubetools_strg_1d_final
  end type strg_1d_t
  !
contains
  !
  subroutine cubetools_strg_1d_reallocate(array,name,n,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(strg_1d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: n
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>STRG>1D>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (n.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (array%n.eq.n) then
          write(mess,'(a,a,i0)')  &
               name,' strg_1d already allocated at the right size: ',n
          call cubetools_message(toolseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' strg_1d already allocated but with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_strg_1d_free(array)
          alloc = .true.
       endif
    else
       ! array%val is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(array%val(n),stat=ier)
       if (failed_allocate(rname,trim(name)//' strg_1d',ier,error)) return
    endif
    ! Allocation success => array%pointeris may be updated
    array%n = n
    array%pointeris = code_pointer_allocated
  end subroutine cubetools_strg_1d_reallocate
  !
  subroutine cubetools_strg_1d_free(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(strg_1d_t), intent(inout) :: array
    !
    character(len=*), parameter :: rname='ARRAY>STRG>1D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       if (associated(array%val)) deallocate(array%val)
    else
       array%val => null()
    endif
    array%n = 0
    array%pointeris = code_pointer_null
  end subroutine cubetools_strg_1d_free
  !
  subroutine cubetools_strg_1d_final(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(strg_1d_t), intent(inout) :: array
    !
    call cubetools_strg_1d_free(array)
  end subroutine cubetools_strg_1d_final
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_strg_1d_list(array,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(strg_1d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>STRG>1D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    print *,array%name,' strg_1d ',array%n,array%pointeris
  end subroutine cubetools_strg_1d_list
end module cubetools_strg_1d_types
!
!------------------------------------------------------------------------
!
! Integer (kind=inte_k) 2D case
!
module cubetools_inte_2d_types
  use cubetools_parameters
  use cubetools_messaging
  !
  public :: inte_2d_t
  private
  !
  type inte_2d_t
     character(len=name_l) :: name = strg_unk               ! Array name
     integer(kind=indx_k)  :: nx = 0                        ! Array first dimension size
     integer(kind=indx_k)  :: ny = 0                        ! Array 2nd   dimension size
     integer(kind=inte_k), pointer :: val(:,:) => null()    ! Array address
     integer(kind=code_k)  :: pointeris = code_pointer_null ! Null, allocated, or associated?
   contains
     procedure, public :: reallocate          => cubetools_inte_2d_reallocate
     procedure, public :: prepare_association => cubetools_inte_2d_prepare_association
     procedure, public :: free                => cubetools_inte_2d_free
     procedure, public :: list                => cubetools_inte_2d_list
     procedure, public :: unallocated         => cubetools_inte_2d_unallocated
     final :: cubetools_inte_2d_final
  end type inte_2d_t
  !
contains
  !
  subroutine cubetools_inte_2d_reallocate(array,name,nx,ny,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(inte_2d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: nx,ny
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>INTE>2D>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nx.le.0 .or. ny.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (array%nx.eq.nx .and.  &
           array%ny.eq.ny) then
          write(mess,'(a,a,i0,a,i0)')  &
               name,' inte_2d already allocated at the right size: ',nx, ' x ',ny
          call cubetools_message(toolseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' inte_2d already allocated but with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_inte_2d_free(array)
          alloc = .true.
       endif
    else
       ! array%val is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(array%val(nx,ny),stat=ier)
       if (failed_allocate(rname,trim(name)//' inte_2d',ier,error)) return
    endif
    ! Allocation success => array%pointeris may be updated
    array%name = name
    array%nx = nx
    array%ny = ny
    array%pointeris = code_pointer_allocated
  end subroutine cubetools_inte_2d_reallocate
  !
  subroutine cubetools_inte_2d_prepare_association(array,name,nx,ny,error)
    !----------------------------------------------------------------------
    ! Prepare for the next reassociation
    !----------------------------------------------------------------------
    class(inte_2d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=pixe_k), intent(in)    :: nx,ny
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='INTE>2D>PREPARE>ASSOCIATION'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nx.le.0 .or. ny.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call array%free()
    ! Association success => image%code_pointer may be updated
    array%name = name
    array%nx = nx
    array%ny = ny
    array%pointeris = code_pointer_null
  end subroutine cubetools_inte_2d_prepare_association
  !
  subroutine cubetools_inte_2d_free(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(inte_2d_t), intent(inout) :: array
    !
    character(len=*), parameter :: rname='ARRAY>INTE>2D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       if (associated(array%val)) deallocate(array%val)
    else
       array%val => null()
    endif
    array%nx = 0
    array%ny = 0
    array%pointeris = code_pointer_null
  end subroutine cubetools_inte_2d_free
  !
  subroutine cubetools_inte_2d_final(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(inte_2d_t), intent(inout) :: array
    !
    call cubetools_inte_2d_free(array)
  end subroutine cubetools_inte_2d_final
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_inte_2d_list(array,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(inte_2d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>INTE>2D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    print *,array%name,' inte_2d ',array%nx,array%ny,array%pointeris
  end subroutine cubetools_inte_2d_list
  !
  function cubetools_inte_2d_unallocated(array,error) result(unallocated)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(inte_2d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    logical                         :: unallocated
    !
    character(len=*), parameter :: rname='ARRAY>INTE>2D>UNALLOCATED'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    unallocated = array%pointeris.eq.code_pointer_null
    if (unallocated) then
       call cubetools_message(seve%e,rname,'Unallocated '//trim(array%name)//' inte_2d array')
       error = .true.
       return
    endif
  end function cubetools_inte_2d_unallocated
end module cubetools_inte_2d_types
!
!------------------------------------------------------------------------
!
! Integer (kind=long_k) 2D case
!
module cubetools_long_2d_types
  use cubetools_parameters
  use cubetools_messaging
  !
  public :: long_2d_t
  private
  !
  type long_2d_t
     character(len=name_l) :: name = strg_unk               ! Array name
     integer(kind=indx_k)  :: nx = 0                        ! Array first dimension size
     integer(kind=indx_k)  :: ny = 0                        ! Array 2nd   dimension size
     integer(kind=long_k), pointer :: val(:,:) => null()    ! Array address
     integer(kind=code_k)  :: pointeris = code_pointer_null ! Null, allocated, or associated?
   contains
     procedure, public :: reallocate          => cubetools_long_2d_reallocate
     procedure, public :: prepare_association => cubetools_long_2d_prepare_association
     procedure, public :: free                => cubetools_long_2d_free
     procedure, public :: list                => cubetools_long_2d_list
     procedure, public :: unallocated         => cubetools_long_2d_unallocated
     final :: cubetools_long_2d_final
  end type long_2d_t
  !
contains
  !
  subroutine cubetools_long_2d_reallocate(array,name,nx,ny,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(long_2d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: nx,ny
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>INTE>2D>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nx.le.0 .or. ny.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (array%nx.eq.nx .and.  &
           array%ny.eq.ny) then
          write(mess,'(a,a,i0,a,i0)')  &
               name,' long_2d already allocated at the right size: ',nx, ' x ',ny
          call cubetools_message(toolseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' long_2d already allocated but with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_long_2d_free(array)
          alloc = .true.
       endif
    else
       ! array%val is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(array%val(nx,ny),stat=ier)
       if (failed_allocate(rname,trim(name)//' long_2d',ier,error)) return
    endif
    ! Allocation success => array%pointeris may be updated
    array%name = name
    array%nx = nx
    array%ny = ny
    array%pointeris = code_pointer_allocated
  end subroutine cubetools_long_2d_reallocate
  !
  subroutine cubetools_long_2d_prepare_association(array,name,nx,ny,error)
    !----------------------------------------------------------------------
    ! Prepare for the next reassociation
    !----------------------------------------------------------------------
    class(long_2d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=pixe_k), intent(in)    :: nx,ny
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='INTE>2D>PREPARE>ASSOCIATION'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nx.le.0 .or. ny.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call array%free()
    ! Association success => image%code_pointer may be updated
    array%name = name
    array%nx = nx
    array%ny = ny
    array%pointeris = code_pointer_null
  end subroutine cubetools_long_2d_prepare_association
  !
  subroutine cubetools_long_2d_free(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(long_2d_t), intent(inout) :: array
    !
    character(len=*), parameter :: rname='ARRAY>INTE>2D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       if (associated(array%val)) deallocate(array%val)
    else
       array%val => null()
    endif
    array%nx = 0
    array%ny = 0
    array%pointeris = code_pointer_null
  end subroutine cubetools_long_2d_free
  !
  subroutine cubetools_long_2d_final(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(long_2d_t), intent(inout) :: array
    !
    call cubetools_long_2d_free(array)
  end subroutine cubetools_long_2d_final
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_long_2d_list(array,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(long_2d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>INTE>2D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    print *,array%name,' long_2d ',array%nx,array%ny,array%pointeris
  end subroutine cubetools_long_2d_list
  !
  function cubetools_long_2d_unallocated(array,error) result(unallocated)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(long_2d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    logical                         :: unallocated
    !
    character(len=*), parameter :: rname='ARRAY>INTE>2D>UNALLOCATED'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    unallocated = array%pointeris.eq.code_pointer_null
    if (unallocated) then
       call cubetools_message(seve%e,rname,'Unallocated '//trim(array%name)//' long_2d array')
       error = .true.
       return
    endif
  end function cubetools_long_2d_unallocated
end module cubetools_long_2d_types
!
!------------------------------------------------------------------------
!
! real(kind=real_k) 2D case
!
module cubetools_real_2d_types
  use cubetools_parameters
  use cubetools_messaging
  !
  public :: real_2d_t
  private
  !
  type real_2d_t
     character(len=name_l) :: name = strg_unk               ! Array name
     integer(kind=indx_k)  :: nx = 0                        ! Array first dimension size
     integer(kind=indx_k)  :: ny = 0                        ! Array 2nd   dimension size
     real(kind=real_k), pointer :: val(:,:) => null()       ! Array address
     integer(kind=code_k)  :: pointeris = code_pointer_null ! Null, allocated, or associated?
   contains
     procedure, public :: reallocate          => cubetools_real_2d_reallocate
     procedure, public :: prepare_association => cubetools_real_2d_prepare_association
     procedure, public :: free                => cubetools_real_2d_free
     procedure, public :: set                 => cubetools_real_2d_set
     procedure, public :: list                => cubetools_real_2d_list
     procedure, public :: unallocated         => cubetools_real_2d_unallocated
     final :: cubetools_real_2d_final
  end type real_2d_t
  !
contains
  !
  subroutine cubetools_real_2d_reallocate(array,name,nx,ny,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(real_2d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: nx,ny
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>REAL>2D>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nx.le.0 .or. ny.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (array%nx.eq.nx .and.  &
           array%ny.eq.ny) then
          write(mess,'(a,a,i0,a,i0)')  &
               name,' real_2d already allocated at the right size: ',nx, ' x ',ny
          call cubetools_message(toolseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' real_2d already allocated but with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_real_2d_free(array)
          alloc = .true.
       endif
    else
       ! array%val is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(array%val(nx,ny),stat=ier)
       if (failed_allocate(rname,trim(name)//' real_2d',ier,error)) return
    endif
    ! Allocation success => array%pointeris may be updated
    array%name = name
    array%nx = nx
    array%ny = ny
    array%pointeris = code_pointer_allocated
  end subroutine cubetools_real_2d_reallocate
  !
  subroutine cubetools_real_2d_prepare_association(array,name,nx,ny,error)
    !----------------------------------------------------------------------
    ! Prepare for the next reassociation
    !----------------------------------------------------------------------
    class(real_2d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=pixe_k), intent(in)    :: nx,ny
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='REAL>2D>PREPARE>ASSOCIATION'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nx.le.0 .or. ny.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call array%free()
    ! Association success => image%code_pointer may be updated
    array%name = name
    array%nx = nx
    array%ny = ny
    array%pointeris = code_pointer_null
  end subroutine cubetools_real_2d_prepare_association
  !
  subroutine cubetools_real_2d_free(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(real_2d_t), intent(inout) :: array
    !
    character(len=*), parameter :: rname='ARRAY>REAL>2D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       if (associated(array%val)) deallocate(array%val)
    else
       array%val => null()
    endif
    array%nx = 0
    array%ny = 0
    array%pointeris = code_pointer_null
  end subroutine cubetools_real_2d_free
  !
  subroutine cubetools_real_2d_final(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(real_2d_t), intent(inout) :: array
    !
    call cubetools_real_2d_free(array)
  end subroutine cubetools_real_2d_final
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_real_2d_set(array,value,error)
    !----------------------------------------------------------------------
    ! Set all array elements to value
    !----------------------------------------------------------------------
    class(real_2d_t),  intent(in)    :: array
    real(kind=real_k), intent(in)    :: value
    logical,           intent(inout) :: error
    !
    integer(kind=indx_k) :: ix,iy
    character(len=*), parameter :: rname='ARRAY>REAL>2D>SET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    do iy=1,array%ny
       do ix=1,array%nx
          array%val(ix,iy) = value
       enddo ! ix
    enddo ! iy
  end subroutine cubetools_real_2d_set
  !
  subroutine cubetools_real_2d_list(array,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(real_2d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>REAL>2D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    print *,array%name,' real_2d ',array%nx,array%ny,array%pointeris
  end subroutine cubetools_real_2d_list
  !
  function cubetools_real_2d_unallocated(array,error) result(unallocated)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(real_2d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    logical                         :: unallocated
    !
    character(len=*), parameter :: rname='ARRAY>REAL>2D>UNALLOCATED'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    unallocated = array%pointeris.eq.code_pointer_null
    if (unallocated) then
       call cubetools_message(seve%e,rname,'Unallocated '//trim(array%name)//' real_2d array')
       error = .true.
       return
    endif
  end function cubetools_real_2d_unallocated
end module cubetools_real_2d_types
!
!------------------------------------------------------------------------
!
! real(kind=dble_k) 2D case
!
module cubetools_dble_2d_types
  use cubetools_parameters
  use cubetools_messaging
  !
  public :: dble_2d_t
  private
  !
  type dble_2d_t
     character(len=name_l) :: name = strg_unk               ! Array name
     integer(kind=indx_k)  :: nx = 0                        ! Array first dimension size
     integer(kind=indx_k)  :: ny = 0                        ! Array 2nd   dimension size
     real(kind=dble_k), pointer :: val(:,:) => null()       ! Array address
     integer(kind=code_k)  :: pointeris = code_pointer_null ! Null, allocated, or associated?
   contains
     procedure, public :: reallocate          => cubetools_dble_2d_reallocate
     procedure, public :: prepare_association => cubetools_dble_2d_prepare_association
     procedure, public :: free                => cubetools_dble_2d_free
     procedure, public :: list                => cubetools_dble_2d_list
     procedure, public :: unallocated         => cubetools_dble_2d_unallocated
     final :: cubetools_dble_2d_final
  end type dble_2d_t
  !
contains
  !
  subroutine cubetools_dble_2d_reallocate(array,name,nx,ny,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(dble_2d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: nx,ny
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>DBLE>2D>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nx.le.0 .or. ny.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (array%nx.eq.nx .and.  &
           array%ny.eq.ny) then
          write(mess,'(a,a,i0,a,i0)')  &
               name,' dble_2d already allocated at the right size: ',nx, ' x ',ny
          call cubetools_message(toolseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' dble_2d already allocated but with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_dble_2d_free(array)
          alloc = .true.
       endif
    else
       ! array%val is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(array%val(nx,ny),stat=ier)
       if (failed_allocate(rname,trim(name)//' dble_2d',ier,error)) return
    endif
    ! Allocation success => array%pointeris may be updated
    array%name = name
    array%nx = nx
    array%ny = ny
    array%pointeris = code_pointer_allocated
  end subroutine cubetools_dble_2d_reallocate
  !
  subroutine cubetools_dble_2d_prepare_association(array,name,nx,ny,error)
    !----------------------------------------------------------------------
    ! Prepare for the next reassociation
    !----------------------------------------------------------------------
    class(dble_2d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=pixe_k), intent(in)    :: nx,ny
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='DBLE>2D>PREPARE>ASSOCIATION'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nx.le.0 .or. ny.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call array%free()
    ! Association success => image%code_pointer may be updated
    array%name = name
    array%nx = nx
    array%ny = ny
    array%pointeris = code_pointer_null
  end subroutine cubetools_dble_2d_prepare_association
  !
  subroutine cubetools_dble_2d_free(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(dble_2d_t), intent(inout) :: array
    !
    character(len=*), parameter :: rname='ARRAY>DBLE>2D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       if (associated(array%val)) deallocate(array%val)
    else
       array%val => null()
    endif
    array%nx = 0
    array%ny = 0
    array%pointeris = code_pointer_null
  end subroutine cubetools_dble_2d_free
  !
  subroutine cubetools_dble_2d_final(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(dble_2d_t), intent(inout) :: array
    !
    call cubetools_dble_2d_free(array)
  end subroutine cubetools_dble_2d_final
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_dble_2d_list(array,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(dble_2d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>DBLE>2D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    print *,array%name,' dble_2d ',array%nx,array%ny,array%pointeris
  end subroutine cubetools_dble_2d_list
  !
  function cubetools_dble_2d_unallocated(array,error) result(unallocated)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(dble_2d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    logical                         :: unallocated
    !
    character(len=*), parameter :: rname='ARRAY>DBLE>2D>UNALLOCATED'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    unallocated = array%pointeris.eq.code_pointer_null
    if (unallocated) then
       call cubetools_message(seve%e,rname,'Unallocated '//trim(array%name)//' dble_2d array')
       error = .true.
       return
    endif
  end function cubetools_dble_2d_unallocated
end module cubetools_dble_2d_types
!
!------------------------------------------------------------------------
!
! cplx(kind=real_k) 2D case
!
module cubetools_cplx_2d_types
  use cubetools_parameters
  use cubetools_messaging
  !
  public :: cplx_2d_t
  private
  !
  type cplx_2d_t
     character(len=name_l) :: name = strg_unk               ! Array name
     integer(kind=indx_k)  :: nx = 0                        ! Array first dimension size
     integer(kind=indx_k)  :: ny = 0                        ! Array 2nd   dimension size
     complex(kind=real_k), pointer :: val(:,:) => null()    ! Array address
     integer(kind=code_k)  :: pointeris = code_pointer_null ! Null, allocated, or associated?
   contains
     procedure, public :: reallocate          => cubetools_cplx_2d_reallocate
     procedure, public :: prepare_association => cubetools_cplx_2d_prepare_association
     procedure, public :: free                => cubetools_cplx_2d_free
     procedure, public :: set                 => cubetools_cplx_2d_set
     procedure, public :: list                => cubetools_cplx_2d_list
     procedure, public :: unallocated         => cubetools_cplx_2d_unallocated
     final :: cubetools_cplx_2d_final
  end type cplx_2d_t
  !
contains
  !
  subroutine cubetools_cplx_2d_reallocate(array,name,nx,ny,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(cplx_2d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: nx,ny
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>CPLX>2D>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nx.le.0 .or. ny.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (array%nx.eq.nx .and.  &
           array%ny.eq.ny) then
          write(mess,'(a,a,i0,a,i0)')  &
               name,' cplx_2d already allocated at the right size: ',nx, ' x ',ny
          call cubetools_message(toolseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' cplx_2d already allocated but with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_cplx_2d_free(array)
          alloc = .true.
       endif
    else
       ! array%val is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(array%val(nx,ny),stat=ier)
       if (failed_allocate(rname,trim(name)//' cplx_2d',ier,error)) return
    endif
    ! Allocation success => array%pointeris may be updated
    array%name = name
    array%nx = nx
    array%ny = ny
    array%pointeris = code_pointer_allocated
  end subroutine cubetools_cplx_2d_reallocate
  !
  subroutine cubetools_cplx_2d_prepare_association(array,name,nx,ny,error)
    !----------------------------------------------------------------------
    ! Prepare for the next reassociation
    !----------------------------------------------------------------------
    class(cplx_2d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=pixe_k), intent(in)    :: nx,ny
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CPLX>2D>PREPARE>ASSOCIATION'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nx.le.0 .or. ny.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call array%free()
    ! Association success => image%code_pointer may be updated
    array%name = name
    array%nx = nx
    array%ny = ny
    array%pointeris = code_pointer_null
  end subroutine cubetools_cplx_2d_prepare_association
  !
  subroutine cubetools_cplx_2d_free(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(cplx_2d_t), intent(inout) :: array
    !
    character(len=*), parameter :: rname='ARRAY>CPLX>2D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       if (associated(array%val)) deallocate(array%val)
    else
       array%val => null()
    endif
    array%nx = 0
    array%ny = 0
    array%pointeris = code_pointer_null
  end subroutine cubetools_cplx_2d_free
  !
  subroutine cubetools_cplx_2d_final(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cplx_2d_t), intent(inout) :: array
    !
    call cubetools_cplx_2d_free(array)
  end subroutine cubetools_cplx_2d_final
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_cplx_2d_set(array,value,error)
    !----------------------------------------------------------------------
    ! Set all array elements to value
    !----------------------------------------------------------------------
    class(cplx_2d_t),     intent(in)    :: array
    complex(kind=real_k), intent(in)    :: value
    logical,              intent(inout) :: error
    !
    integer(kind=indx_k) :: ix,iy
    character(len=*), parameter :: rname='ARRAY>CPLX>2D>SET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    do iy=1,array%ny
       do ix=1,array%nx
          array%val(ix,iy) = value
       enddo ! ix
    enddo ! iy
  end subroutine cubetools_cplx_2d_set
  !
  subroutine cubetools_cplx_2d_list(array,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(cplx_2d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>CPLX>2D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    print *,array%name,' cplx_2d ',array%nx,array%ny,array%pointeris
  end subroutine cubetools_cplx_2d_list
  !
  function cubetools_cplx_2d_unallocated(array,error) result(unallocated)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(cplx_2d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    logical                         :: unallocated
    !
    character(len=*), parameter :: rname='ARRAY>CPLX>2D>UNALLOCATED'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    unallocated = array%pointeris.eq.code_pointer_null
    if (unallocated) then
       call cubetools_message(seve%e,rname,'Unallocated '//trim(array%name)//' cplx_2d array')
       error = .true.
       return
    endif
  end function cubetools_cplx_2d_unallocated
end module cubetools_cplx_2d_types
!
!--------------------------------------------------------------------------
!
! real(kind=real_k) 3D case
!
module cubetools_real_3d_types
  use cubetools_parameters
  use cubetools_messaging
  !
  public :: real_3d_t
  private
  !
  type real_3d_t
     character(len=name_l) :: name = strg_unk               ! Array name
     integer(kind=indx_k)  :: nx = 0                        ! Array first dimension size
     integer(kind=indx_k)  :: ny = 0                        ! Array 2nd   dimension size
     integer(kind=indx_k)  :: nz = 0                        ! Array 3rd   dimension size
     real(kind=real_k), pointer :: val(:,:,:) => null()     ! Array address
     integer(kind=code_k)  :: pointeris = code_pointer_null ! Null, allocated, or associated?
   contains
     procedure, public :: reallocate          => cubetools_real_3d_reallocate
     procedure, public :: prepare_association => cubetools_real_3d_prepare_association
     procedure, public :: free                => cubetools_real_3d_free
     procedure, public :: set                 => cubetools_real_3d_set
     procedure, public :: list                => cubetools_real_3d_list
     procedure, public :: unallocated         => cubetools_real_3d_unallocated
     final :: cubetools_real_3d_final
  end type real_3d_t
  !
contains
  !
  subroutine cubetools_real_3d_reallocate(array,name,nx,ny,nz,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(real_3d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: nx,ny,nz
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>REAL>3D>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nx.le.0 .or. ny.le.0 .or. nz.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (array%nx.eq.nx .and. &
           array%ny.eq.ny .and. &
           array%nz.eq.nz) then
          write(mess,'(a,a,i0,a,i0,a,i0)')  &
               name,' real_3d already allocated at the right size: ',nx, ' x ',ny, ' x ',nz
          call cubetools_message(toolseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' real_3d already allocated but with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_real_3d_free(array)
          alloc = .true.
       endif
    else
       ! array%val is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(array%val(nx,ny,nz),stat=ier)
       if (failed_allocate(rname,trim(name)//' real_3d',ier,error)) return
    endif
    ! Allocation success => array%pointeris may be updated
    array%name = name
    array%nx = nx
    array%ny = ny
    array%nz = nz
    array%pointeris = code_pointer_allocated
  end subroutine cubetools_real_3d_reallocate
  !
  subroutine cubetools_real_3d_prepare_association(array,name,nx,ny,nz,error)
    !----------------------------------------------------------------------
    ! Prepare for the next reassociation
    !----------------------------------------------------------------------
    class(real_3d_t),     intent(inout) :: array
    character(len=*),     intent(in)    :: name
    integer(kind=pixe_k), intent(in)    :: nx,ny,nz
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='REAL>3D>PREPARE>ASSOCIATION'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nx.le.0 .or. ny.le.0 .or. nz.le.0) then
       call cubetools_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call array%free()
    ! Association success => image%code_pointer may be updated
    array%name = name
    array%nx = nx
    array%ny = ny
    array%nz = nz
    array%pointeris = code_pointer_null
  end subroutine cubetools_real_3d_prepare_association
  !
  subroutine cubetools_real_3d_free(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(real_3d_t), intent(inout) :: array
    !
    character(len=*), parameter :: rname='ARRAY>REAL>3D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (array%pointeris.eq.code_pointer_allocated) then
       if (associated(array%val)) deallocate(array%val)
    else
       array%val => null()
    endif
    array%nx = 0
    array%ny = 0
    array%nz = 0
    array%pointeris = code_pointer_null
  end subroutine cubetools_real_3d_free
  !
  subroutine cubetools_real_3d_final(array)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(real_3d_t), intent(inout) :: array
    !
    call cubetools_real_3d_free(array)
  end subroutine cubetools_real_3d_final
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetools_real_3d_set(array,value,error)
    !----------------------------------------------------------------------
    ! Set all array elements to value
    !----------------------------------------------------------------------
    class(real_3d_t),  intent(in)    :: array
    real(kind=real_k), intent(in)    :: value
    logical,           intent(inout) :: error
    !
    integer(kind=indx_k) :: ix,iy,iz
    character(len=*), parameter :: rname='ARRAY>REAL>3D>SET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    do iz=1,array%nz
       do iy=1,array%ny
          do ix=1,array%nx
             array%val(ix,iy,iz) = value
          enddo ! ix
       enddo ! iy
    enddo ! iz
  end subroutine cubetools_real_3d_set
  !
  subroutine cubetools_real_3d_list(array,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(real_3d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>REAL>3D>FREE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    print *,array%name,' real_3d ',array%nx,array%ny,array%nz,array%pointeris
  end subroutine cubetools_real_3d_list
  !
  function cubetools_real_3d_unallocated(array,error) result(unallocated)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(real_3d_t), intent(in)    :: array
    logical,          intent(inout) :: error
    logical                         :: unallocated
    !
    character(len=*), parameter :: rname='ARRAY>REAL>3D>UNALLOCATED'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    unallocated = array%pointeris.eq.code_pointer_null
    if (unallocated) then
       call cubetools_message(seve%e,rname,'Unallocated '//trim(array%name)//' real_3d array')
       error = .true.
       return
    endif
  end function cubetools_real_3d_unallocated
end module cubetools_real_3d_types
!
!------------------------------------------------------------------------
!
module cubetools_array_types
  use cubetools_messaging
  !
  use cubetools_inte_1d_types
  use cubetools_long_1d_types
  use cubetools_real_1d_types
  use cubetools_dble_1d_types
  use cubetools_cplx_1d_types
  use cubetools_strg_1d_types
  !
  use cubetools_inte_2d_types
  use cubetools_long_2d_types
  use cubetools_real_2d_types
  use cubetools_dble_2d_types
  use cubetools_cplx_2d_types
  !
  use cubetools_real_3d_types
  !
  public :: inte_1d_t,long_1d_t,real_1d_t,dble_1d_t,cplx_1d_t,strg_1d_t
  public :: inte_2d_t,long_2d_t,real_2d_t,dble_2d_t,cplx_2d_t
  public :: real_3d_t
  public :: cubetools_array_2d_have_different_size
  private
  !
contains
  !
  function cubetools_array_2d_have_different_size(array1,array2,error) result(different)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(real_2d_t), intent(in)    :: array1
    class(cplx_2d_t), intent(in)    :: array2
    logical,          intent(inout) :: error
    logical                         :: different
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRAY>2D>HAVE>DIFFERENT>SIZE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    different = (array1%nx.ne.array2%nx).or.(array1%ny.ne.array2%ny)
    if (different) then
       call cubetools_message(seve%e,rname,'Different sizes for')
       write(mess,'(2x,a,i0,a,i0,a)')  &
               trim(array1%name)//': [',array1%nx,'x',array1%ny,']'
       call cubetools_message(seve%e,rname,mess)
       write(mess,'(2x,a,i0,a,i0,a)')  &
               trim(array2%name)//': [',array2%nx,'x',array2%ny,']'
       call cubetools_message(seve%e,rname,mess)
       error = .true.
       return
    endif
  end function cubetools_array_2d_have_different_size
end module cubetools_array_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
