!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_arrelt_types
  use cubetools_parameters
  use cubetools_messaging
  use cubetools_consistency_types
  !
  public :: arrelt_t,arrelt_cons_t
  public :: cubetools_arrelt_init,cubetools_arrelt_get_and_derive
  public :: cubetools_arrelt_final,cubetools_arrelt_put
  public :: cubetools_arrelt_list,cubetools_arrelt_sicdef,cubetools_arrelt_copy
  public :: cubetools_arrelt_consistency_init,cubetools_arrelt_consistency_final
  public :: cubetools_arrelt_consistency_check,cubetools_arrelt_consistency_print
  private
  !
  type arrelt_t
     character(len=12)    :: name = strg_unk ! [---] Name  of data element
     real(kind=sign_k)    :: val = 0         ! [***] Value of data element
     integer(kind=data_k) :: loc(maxdim)     ! [***] Position of data element
     integer(kind=pixe_k), pointer :: ix => null()  ! [pix] Position along x axis
     integer(kind=pixe_k), pointer :: iy => null()  ! [pix] Position along y axis
     integer(kind=chan_k), pointer :: ic => null()  ! [cha] Position along c axis
  contains
     procedure, public :: associate => cubetools_arrelt_associate
  end type arrelt_t
  !
  type arrelt_cons_t
     logical                  :: check=.true.    ! Check the section
     logical                  :: prob =.false.   ! Is there a problem
     logical                  :: mess =.true.    ! Output message for this section?
     type(consistency_desc_t) :: name            ! [---] Name  of data element
     type(consistency_desc_t) :: val             ! [***] Value of data element
     type(consistency_desc_t) :: loc(maxdim)     ! [***] Position of data element
     type(consistency_desc_t) :: ix              ! [pix] Position along x axis
     type(consistency_desc_t) :: iy              ! [pix] Position along y axis
     type(consistency_desc_t) :: ic              ! [cha] Position along c axis
  end type arrelt_cons_t
  !
contains
  !
  subroutine cubetools_arrelt_init(name,arrelt,error)
    use cubetools_nan
    !-------------------------------------------------------------------
    ! Initialize the type. The name of elements (Min or Max) is defined
    ! once and for all. That's why it happens here and not in
    ! get_and_derived
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: name
    type(arrelt_t),   intent(inout) :: arrelt
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRELT>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    arrelt%name = name
    arrelt%val = gr4nan
    arrelt%loc(:) = 0
    ! The scalar pointers can not be pointed to the proper %loc(i) yet, as
    ! long as the head%set%il, %im, and %ic are not available.
    arrelt%ix => null()
    arrelt%iy => null()
    arrelt%ic => null()
  end subroutine cubetools_arrelt_init
  !
  subroutine cubetools_arrelt_associate(arrelt,il,im,ic,error)
    !-------------------------------------------------------------------
    ! (Re)associate the ix iy ic pointers to the proper location element
    !-------------------------------------------------------------------
    class(arrelt_t), target, intent(inout) :: arrelt
    integer(kind=ndim_k),    intent(in)    :: il,im,ic
    logical,                 intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ARRELT>ASSOCIATE'
    !
    if (il.le.0 .or. im.le.0 .or. ic.le.0) then
      write(mess,'(A,3(1X,I0),A)')  &
        'Internal error: IL IM IC should be non-zero (got',il,im,ic,')'
      call cubetools_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    arrelt%ix => arrelt%loc(il)
    arrelt%iy => arrelt%loc(im)
    arrelt%ic => arrelt%loc(ic)
  end subroutine cubetools_arrelt_associate
  !
  subroutine cubetools_arrelt_get_and_derive(value,location,arrelt,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    real(kind=sign_k),    intent(in)    :: value
    integer(kind=data_k), intent(in)    :: location(:)
    type(arrelt_t),       intent(inout) :: arrelt
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRELT>GET>AND>DERIVE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    arrelt%val = value
    arrelt%loc = location
  end subroutine cubetools_arrelt_get_and_derive
  !
  subroutine cubetools_arrelt_put(arrelt,value,location,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(arrelt_t),       intent(in)    :: arrelt
    real(kind=sign_k),    intent(out)   :: value
    integer(kind=data_k), intent(out)   :: location(:)
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRELT>PUT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    value = arrelt%val 
    location = arrelt%loc
  end subroutine cubetools_arrelt_put
  !
  subroutine cubetools_arrelt_final(arrelt,error)
    !-------------------------------------------------------------------
    ! Just reinitialize the type
    !-------------------------------------------------------------------
    type(arrelt_t), intent(inout) :: arrelt
    logical,        intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRELT>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    arrelt%loc(:) = 0
  end subroutine cubetools_arrelt_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_arrelt_list(arrelt,error)
    use cubetools_format
    !-------------------------------------------------------------------
    ! *** JP Should the arrelt also show the range of the axes?
    ! *** JP It would be so good to have the position in natural units as well...
    !-------------------------------------------------------------------
    type(arrelt_t), intent(in)    :: arrelt
    logical,        intent(inout) :: error
    !
    integer(kind=ndim_k) :: iaxis
    character(len=mess_l) :: mess,position
    character(len=*), parameter :: rname='ARRELT>LIST'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    mess = cubetools_format_stdkey_boldval(arrelt%name,arrelt%val,fsimple,22)
    write(position,'(a,i0)') '(',arrelt%loc(1)
    do iaxis = 2,maxdim
       write(position,'(a,a,i0)') trim(position),',',arrelt%loc(iaxis)
    enddo ! iaxis
    write(position,'(a,a)') trim(position),')'
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('at',position,30)
    call cubetools_message(seve%r,rname,mess)    
  end subroutine cubetools_arrelt_list
  !
  subroutine cubetools_arrelt_sicdef(name,arrelt,readonly,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: name
    type(arrelt_t),   intent(in)    :: arrelt
    logical,          intent(in)    :: readonly
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='ELT>SICDEF'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call sic_defstructure(name,global,error)
    if (error) return
    call sic_def_real(trim(name)//'%val',arrelt%val,0,0,readonly,error)
    if (error) return
    call sic_def_long(trim(name)//'%ix',arrelt%ix,0,0,readonly,error)
    if (error) return
    call sic_def_long(trim(name)//'%iy',arrelt%iy,0,0,readonly,error)
    if (error) return
    call sic_def_long(trim(name)//'%ic',arrelt%ic,0,0,readonly,error)
    if (error) return
  end subroutine cubetools_arrelt_sicdef
  !
  subroutine cubetools_arrelt_copy(in,ou,error)
    !----------------------------------------------------------------------
    !
    ! ----------------------------------------------------------------------
    type(arrelt_t), intent(in)    :: in
    type(arrelt_t), intent(out)   :: ou
    logical,        intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRELT>COPY'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    ou = in
  end subroutine cubetools_arrelt_copy
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_arrelt_consistency_init(cons,error)
    !-------------------------------------------------------------------
    ! Init the consistency between array elements
    !-------------------------------------------------------------------
    type(arrelt_cons_t), intent(out)   :: cons
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>ARRELT>CONSISTENCY>INIT'
    integer(kind=ndim_k) :: idim
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_init(notol,check,mess,cons%name,error)
    if (error) return
    call cubetools_consistency_init(strict,check,mess,cons%val,error)
    if (error) return
    do idim=1,maxdim
       call cubetools_consistency_init(notol,check,mess,cons%loc(idim),error)
       if (error) return
    enddo
    call cubetools_consistency_init(notol,check,mess,cons%ix,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%iy,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%ic,error)
    if (error) return
    !
  end subroutine cubetools_arrelt_consistency_init
  !
  subroutine cubetools_arrelt_consistency_check(cons,arrelt1,arrelt2,error)
    !-------------------------------------------------------------------
    ! Check the consistency between array elements
    !-------------------------------------------------------------------
    type(arrelt_cons_t), intent(inout) :: cons
    type(arrelt_t),      intent(in)    :: arrelt1
    type(arrelt_t),      intent(in)    :: arrelt2
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>ARRELT>CONSISTENCY>CHECK'
    integer(kind=ndim_k) :: idim
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = .false.
    call cubetools_consistency_string_check(cons%name,arrelt1%name,arrelt2%name,error)
    if (error) return
    call cubetools_consistency_real_check(cons%val,arrelt1%val,arrelt2%val,error)
    if (error) return
    do idim=1,maxdim
       call cubetools_consistency_integer_check(cons%loc(idim),arrelt1%loc(idim),arrelt2%loc(idim),error)
       if (error) return
    enddo
    call cubetools_consistency_integer_check(cons%ix,arrelt1%ix,arrelt2%ix,error)
    if (error) return
    call cubetools_consistency_integer_check(cons%iy,arrelt1%iy,arrelt2%iy,error)
    if (error) return
    call cubetools_consistency_integer_check(cons%ic,arrelt1%ic,arrelt2%ic,error)
    if (error) return
    !
    cons%prob = cons%name%prob.or.cons%val%prob.or.any(cons%loc(:)%prob).or.&
         cons%ix%prob.or.cons%iy%prob.or.cons%ic%prob
  end subroutine cubetools_arrelt_consistency_check
  !
  subroutine cubetools_arrelt_consistency_print(label,unit1,unit2,cons,arrelt1,arrelt2,error)
    !-------------------------------------------------------------------
    ! Print the consistency between array elements
    !-------------------------------------------------------------------
    character(len=*),    intent(in)    :: label
    character(len=*),    intent(in)    :: unit1
    character(len=*),    intent(in)    :: unit2
    type(arrelt_cons_t), intent(in)    :: cons
    type(arrelt_t),      intent(in)    :: arrelt1
    type(arrelt_t),      intent(in)    :: arrelt2
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>ARRELT>CONSISTENCY>PRINT'
    integer(kind=ndim_k) :: idim
    character(len=argu_l) :: dimname
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title(label,3,cons%check,cons%prob,error)
    if (error) return
    if (cons%check.and.cons%prob) then
       call cubetools_consistency_string_print('Names',cons%name,arrelt1%name,arrelt2%name,error)
       if (error) return
       call cubetools_consistency_real_print('Values',unit1,unit2,cons%val,arrelt1%val,arrelt2%val,error)
       if (error) return
       do idim=1,maxdim
          write(dimname,'(a,i0)') 'Pos. axis #',idim
          call cubetools_consistency_integer_print(trim(dimname),cons%loc(idim),&
               arrelt1%loc(idim),arrelt2%loc(idim),error)
          if (error) return
       enddo
       call cubetools_consistency_integer_print('Pos. L axis',cons%ix,arrelt1%ix,arrelt2%ix,error)
       if (error) return
       call cubetools_consistency_integer_print('Pos. M axis',cons%iy,arrelt1%iy,arrelt2%iy,error)
       if (error) return
       call cubetools_consistency_integer_print('Pos. C axis',cons%ic,arrelt1%ic,arrelt2%ic,error)
       if (error) return
    endif
    call cubetools_message(seve%r,rname,'')
  end subroutine cubetools_arrelt_consistency_print
  !
  subroutine cubetools_arrelt_consistency_final(cons,error)
    !-------------------------------------------------------------------
    ! Final the consistency between array elements
    !-------------------------------------------------------------------
    type(arrelt_cons_t), intent(out)   :: cons
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='ARRAY>ARRELT>CONSISTENCY>FINAL'
    integer(kind=ndim_k) :: idim
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_final(cons%name,error)
    if (error) return
    call cubetools_consistency_final(cons%val,error)
    if (error) return
    do idim=1,maxdim
       call cubetools_consistency_final(cons%loc(idim),error)
       if (error) return
    enddo
    call cubetools_consistency_final(cons%ix,error)
    if (error) return
    call cubetools_consistency_final(cons%iy,error)
    if (error) return
    call cubetools_consistency_final(cons%ic,error)
    if (error) return
    !
  end subroutine cubetools_arrelt_consistency_final
end module cubetools_arrelt_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
