!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! 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 :: list        => cubetools_cplx_1d_list
     procedure, public :: free        => cubetools_cplx_1d_free
     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_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
  !
  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
end module cubetools_cplx_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 :: 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_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
!
!--------------------------------------------------------------------------
!
! 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 :: 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_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_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 :: 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_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
!
!------------------------------------------------------------------------
!
module cubetools_array_types
  use cubetools_messaging
  !
  use cubetools_cplx_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 :: real_3d_t
  public :: inte_2d_t,long_2d_t,real_2d_t,dble_2d_t,cplx_2d_t
  public :: cplx_1d_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
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
