!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_axis_types
  use gkernel_interfaces
  use cubetools_parameters
  use cubetools_messaging
  use cubetools_unit
  use cubetools_consistency_types
  use cubetools_structure
  use cubetools_unit_arg
  !
  public :: axis_t,axis_user_t,axis_cons_t,axis_opt_t
  public :: cubetools_axis_associate,cubetools_axis_derive ! *** JP should these ones actually be public?
  public :: cubetools_axis_init,cubetools_axis_put_and_derive
  public :: cubetools_axis_reinitialize,cubetools_axis_get
  public :: cubetools_axis_rederive
  public :: cubetools_axis_list,cubetools_axis_register_sub
  public :: cubetools_axis_parse_sub,cubetools_axis_user2prog_sub
  public :: cubetools_axis_sicdef,cubetools_axis_axis2userstruct,cubetools_axis_copy
  public :: cubetools_axis_consistency_init,cubetools_axis_consistency_final
  public :: cubetools_axis_consistency_check,cubetools_axis_consistency_print
  public :: cubetools_axis_consistency_set_tol
  public :: cubetools_axis_intersect
  public :: cubetools_axis_offset2pixel,cubetools_axis_pixel2offset
  private
  !
  interface cubetools_axis_put_and_derive
     module procedure cubetools_axis_put_convert_and_derive
     module procedure cubetools_axis_put_refvalinc_and_derive
  end interface cubetools_axis_put_and_derive
  !
  interface cubetools_axis_offset2pixel
     module procedure cubetools_axis_offset2pixel_coor
     module procedure cubetools_axis_offset2pixel_indx
  end interface cubetools_axis_offset2pixel
  !
  interface cubetools_axis_pixel2offset
     module procedure cubetools_axis_pixel2offset_coor
     module procedure cubetools_axis_pixel2offset_indx
  end interface cubetools_axis_pixel2offset
  !
  type axis_t
     character(len=unit_l)      :: name = strg_unk         ! Associated name
     character(len=unit_l)      :: unit = strg_unk         ! Associated unit
     integer(kind=code_k)       :: kind = code_unit_unk    ! Associated kind for unit conversion
     logical                    :: genuine = .false.       ! Genuine or invented (l,m,c)?
     logical                    :: regular = .false.       ! Regularly spaced array?
     real(kind=coor_k)          :: conv(3) = [0d0,0d0,1d0] ! Axis definition for regularly spaced array
     real(kind=coor_k), pointer :: ref => null()           ! Reference channel
     real(kind=coor_k), pointer :: val => null()           ! Value     at reference channel
     real(kind=coor_k), pointer :: inc => null()           ! Increment at reference channel
     real(kind=coor_k), pointer :: coord(:) => null()      ! Axis coordinates
     real(kind=coor_k), private :: min,max                 ! Axis extrema
     integer(kind=code_k)       :: pointeris = code_pointer_null ! Null, allocated, or associated?
     integer(kind=chan_k)       :: n = 0                   ! Number of coordinates
   contains
     procedure, private :: inside_chan  => cubetools_axis_inside_chan
     procedure, private :: inside_coord => cubetools_axis_inside_coord
     generic,   public  :: inside       => inside_chan,inside_coord
     procedure, public  :: set_ref_to   => cubetools_axis_set_ref_to
     procedure, public  :: get_min      => cubetools_axis_get_min
     procedure, public  :: get_max      => cubetools_axis_get_max
     final              :: cubetools_axis_final
  end type axis_t
  !
  type axis_opt_t
     type(option_t),   pointer :: opt
     type(unit_arg_t), pointer :: unit_arg
   contains
     procedure :: register  => cubetools_axis_register
     procedure :: parse     => cubetools_axis_parse
     procedure :: user2prog => cubetools_axis_user2prog
  end type axis_opt_t
  !
  type axis_user_t
     character(len=argu_l) :: n    = strg_unk     ! User axis size
     character(len=argu_l) :: ref  = strg_unk     ! User reference channel|pixel
     character(len=argu_l) :: val  = strg_unk     ! User value at reference   
     character(len=argu_l) :: inc  = strg_unk     ! User increment
     character(len=argu_l) :: unit = strg_unk     ! User unit for axis
     logical               :: do = .false.        ! Option was present
     logical               :: reallocate = .true. ! Reallocate the coordinate array
  end type axis_user_t
  !
  type axis_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
     type(consistency_desc_t) :: genuine
     type(consistency_desc_t) :: regular
     type(consistency_desc_t) :: unit
     type(consistency_desc_t) :: n
     type(consistency_desc_t) :: inc
     type(consistency_desc_t) :: left
     type(consistency_desc_t) :: right
  end type axis_cons_t
  !
contains
  !
  subroutine cubetools_axis_init(axis,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(axis_t), intent(out)   :: axis
    logical,      intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>INIT'
    !
    call cubetools_message(toolseve%trace,rname,trim(axis%name)//' axis')
    !
    call cubetools_axis_associate(axis,error)
    if (error) return
  end subroutine cubetools_axis_init
  !
  subroutine cubetools_axis_put_convert_and_derive(genuine,name,unit,kind,&
       n,conv,axis,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    logical,              intent(in)    :: genuine
    character(len=*),     intent(in)    :: name
    character(len=*),     intent(in)    :: unit
    integer(kind=code_k), intent(in)    :: kind
    integer(kind=data_k), intent(in)    :: n
    real(kind=coor_k),    intent(in)    :: conv(3)
    type(axis_t),         intent(inout) :: axis
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>PUT>CONVERT>AND>DERIVE'
    !
    call cubetools_message(toolseve%trace,rname,trim(name)//' axis')
    !
    axis%genuine = genuine
    axis%name = name
    axis%unit = unit
    axis%kind = kind
    call cubetools_axis_put_convert(conv,axis,error)
    if (error) return
    call cubetools_axis_derive(n,axis,error)
    if (error) return
  end subroutine cubetools_axis_put_convert_and_derive
  !
  subroutine cubetools_axis_put_refvalinc_and_derive(genuine,name,unit,kind,&
       n,ref,val,inc,axis,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    logical,              intent(in)    :: genuine
    character(len=*),     intent(in)    :: name
    character(len=*),     intent(in)    :: unit
    integer(kind=code_k), intent(in)    :: kind
    integer(kind=data_k), intent(in)    :: n
    real(kind=coor_k),    intent(in)    :: ref
    real(kind=coor_k),    intent(in)    :: val
    real(kind=coor_k),    intent(in)    :: inc
    type(axis_t),         intent(inout) :: axis
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>PUT>REFVALINC>AND>DERIVE'
    !
    call cubetools_message(toolseve%trace,rname,trim(name)//' axis')
    !
    axis%genuine = genuine
    axis%name = name
    axis%unit = unit
    axis%kind = kind
    call cubetools_axis_put_refvalinc(ref,val,inc,axis,error)
    if (error) return
    call cubetools_axis_derive(n,axis,error)
    if (error) return
  end subroutine cubetools_axis_put_refvalinc_and_derive
  !
  subroutine cubetools_axis_derive(n,axis,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    integer(kind=data_k), intent(in)    :: n
    type(axis_t),         intent(inout) :: axis
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>DERIVE'
    !
    call cubetools_message(toolseve%trace,rname,trim(axis%name)//' axis')
    !
    call cubetools_axis_reallocate(n,axis,error)
    if (error) return
    call cubetools_axis_derive_coord(axis,error)
    if (error) return
  end subroutine cubetools_axis_derive
  !
  subroutine cubetools_axis_rederive(axis,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(axis_t), intent(inout) :: axis
    logical,      intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>REDERIVE'
    !
    call cubetools_message(toolseve%trace,rname,trim(axis%name)//' axis')
    !
    call cubetools_axis_reallocate(axis%n,axis,error)
    if (error) return
    call cubetools_axis_derive_coord(axis,error)
    if (error) return
  end subroutine cubetools_axis_rederive
  !
  subroutine cubetools_axis_derive_coord(axis,error)
    use cubetools_nan
    !-------------------------------------------------------------------
    ! Compute a regular axis from n,ref,val,inc
    !-------------------------------------------------------------------
    type(axis_t), intent(inout) :: axis
    logical,      intent(inout) :: error
    !
    integer(kind=indx_k) :: ic
    character(len=*), parameter :: rname='AXIS>DERIVE>COORD'
    !
    call cubetools_message(toolseve%trace,rname,trim(axis%name)//' axis')
    !
    do ic=1,axis%n
       axis%coord(ic) = (ic-axis%ref)*axis%inc+axis%val
    enddo ! ic
    axis%min = gr8nan  ! Computed at first call to get_min() method
    axis%max = gr8nan  ! Computed at first call to get_max() method
    axis%regular = .true.
  end subroutine cubetools_axis_derive_coord
  !
  function cubetools_axis_get_min(axis)
    use ieee_arithmetic
    !-------------------------------------------------------------------
    ! Return the axis min value from the full range
    !-------------------------------------------------------------------
    real(kind=coor_k) :: cubetools_axis_get_min
    class(axis_t), intent(inout) :: axis
    if (ieee_is_nan(axis%min))  call cubetools_axis_compute_minmax(axis)
    cubetools_axis_get_min = axis%min
  end function cubetools_axis_get_min
  !
  function cubetools_axis_get_max(axis)
    use ieee_arithmetic
    !-------------------------------------------------------------------
    ! Return the axis max value from the full range
    !-------------------------------------------------------------------
    real(kind=coor_k) :: cubetools_axis_get_max
    class(axis_t), intent(inout) :: axis
    if (ieee_is_nan(axis%max))  call cubetools_axis_compute_minmax(axis)
    cubetools_axis_get_max = axis%max
  end function cubetools_axis_get_max
  !
  subroutine cubetools_axis_compute_minmax(axis)
    !-------------------------------------------------------------------
    ! Recompute the axis min-max values from the full range
    !-------------------------------------------------------------------
    class(axis_t), intent(inout) :: axis
    !
    real(kind=coor_k) :: left,right
    !
    left  = (       0.5d0-axis%ref)*axis%inc+axis%val
    right = (axis%n+0.5d0-axis%ref)*axis%inc+axis%val
    if (left.lt.right) then
      axis%min = left
      axis%max = right
    else
      axis%min = right
      axis%max = left
    endif
  end subroutine cubetools_axis_compute_minmax
  !
  subroutine cubetools_axis_get(axis,genuine,name,unit,kind,n,conv,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(axis_t),         intent(in)    :: axis
    logical,              intent(out)   :: genuine
    character(len=*),     intent(out)   :: name
    character(len=*),     intent(out)   :: unit
    integer(kind=code_k), intent(out)   :: kind
    integer(kind=data_k), intent(out)   :: n
    real(kind=coor_k),    intent(out)   :: conv(3)
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>GET'
    !
    call cubetools_message(toolseve%trace,rname,trim(axis%name)//' axis')
    !
    genuine = axis%genuine
    name = axis%name
    unit = axis%unit
    kind = axis%kind
    n = axis%n
    conv = axis%conv
  end subroutine cubetools_axis_get
  !
  subroutine cubetools_axis_reinitialize(axis,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    type(axis_t), intent(inout) :: axis
    logical,      intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,trim(axis%name)//' axis')
    !
    call cubetools_axis_free(axis,error)
    if (error) return
    call cubetools_axis_init(axis,error) ! To reset axis to default values
    if (error) return
  end subroutine cubetools_axis_reinitialize
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_axis_list(axis,format,nchar,error)
    use cubetools_format
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(axis_t),     intent(in)    :: axis
    character(len=*), intent(in)    :: format
    integer(kind=4),  intent(in)    :: nchar
    logical,          intent(inout) :: error
    !
    type(unit_user_t) :: unit
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='AXIS>LIST'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call unit%get_from_code(axis%kind,error)
    if (error) return
    if (axis%kind.eq.code_unit_unk) unit%name = axis%unit
    if (axis%n.lt.1000000) then
       mess = cubetools_format_stdkey_boldval(axis%name,axis%n,'i6',18)
    else
       mess = cubetools_format_stdkey_boldval(axis%name,'>= 1e6',18)
    endif
    mess = trim(mess)//' '//cubetools_format_stdkey_boldval('',axis%ref,format,nchar)
    mess = trim(mess)//' '//cubetools_format_stdkey_boldval('',axis%val*unit%user_per_prog,format,nchar)
    mess = trim(mess)//' '//cubetools_format_stdkey_boldval('',axis%inc*unit%user_per_prog,format,nchar)
    mess = trim(mess)//' '//cubetools_format_stdkey_boldval('',unit%name,12)
    if (axis%genuine) then
       mess = trim(mess)//' '//cubetools_format_stdkey_boldval('','G',2)
    else
       mess = trim(mess)//' '//cubetools_format_stdkey_boldval('','D',2)
    endif
    call cubetools_message(seve%r,rname,mess)
  end subroutine cubetools_axis_list
  !
  subroutine cubetools_axis_register(axis,kind,name,abstract,error)
    !----------------------------------------------------------------------
    ! Register a simple /AXIS option under a given name, abstract and help
    ! into the option
    !----------------------------------------------------------------------
    class(axis_opt_t),    intent(out)   :: axis
    integer(kind=code_K), intent(in)    :: kind
    character(len=*),     intent(in)    :: name
    character(len=*),     intent(in)    :: abstract
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>REGISTER'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         name,'n ref val inc [unit]',&
         abstract,&
         strg_id,&
         axis%opt,error)
    if (error) return
    call cubetools_axis_register_sub(kind,axis%unit_arg,error)
    if (error) return
  end subroutine cubetools_axis_register
  !
  subroutine cubetools_axis_register_sub(kind,actualarg,error)
    !----------------------------------------------------------------------
    ! Register arguments of an /AXIS after the option name
    !----------------------------------------------------------------------
    integer(kind=code_K),      intent(in)    :: kind
    type(unit_arg_t), pointer, intent(out)   :: actualarg
    logical,                   intent(inout) :: error
    !
    type(unit_arg_t) :: unitarg
    type(standard_arg_t) :: stdarg
    !
    character(len=*), parameter :: unitname = 'unit'
    character(len=*), parameter :: unitabs  = 'Unit for val and inc'
    character(len=*), parameter :: unithlp  = '"*" or "=" mean current unit for axis kind is used'
    !
    character(len=*), parameter :: rname='AXIS>REGISTER>SUB'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    call stdarg%register( &
         'n',  &
         'number of elements in axis', &
         '"=" means unchanged, "*" means the last input and output&
         & axis element are aligned',&
         code_arg_mandatory, error)
    if (error) return
    call stdarg%register( &
         'ref',  &
         'Axis reference point', &
         '"=" means unchanged, "*" means the first input and output&
         & axis element are aligned',&
         code_arg_mandatory, &
         error)
    if (error) return
    call stdarg%register( &
         'val',  &
         'Axis value at reference point', &
         '"*" or "=" mean previous value is kept',&
         code_arg_mandatory, &
         error)
    if (error) return
    call stdarg%register( &
         'inc',  &
         'Axis increment', &
         '"=" means unchanged, "*" means that the increment will be&
         & chosen as to preserve the edges of the axis according to&
         & its current number of elements', &
         code_arg_mandatory, error)
    if (error) return
    !
    if (kind.eq.code_unit_fov  .or. kind.eq.code_unit_velo .or.  &
        kind.eq.code_unit_freq .or. kind.eq.code_unit_unk) then
      ! ZZZ Why not all units allowed?
      call unitarg%register(unitname,          &
                            unitabs,           &
                            unithlp,           &
                            code_arg_optional, &
                            kind,              &
                            actualarg,         &
                            error)
      if (error) return
    else
       call cubetools_message(seve%e,rname,'Cannot register an axis with unrecognized kind')
       error = .true.
       return
    endif
  end subroutine cubetools_axis_register_sub
  !
  subroutine cubetools_axis_parse(axis,line,user,error)
    !----------------------------------------------------------------------
    ! Parse axis description
    ! /AXIS n ref val inc [unit]
    !----------------------------------------------------------------------
    class(axis_opt_t), intent(in)    :: axis
    character(len=*),  intent(in)    :: line
    type(axis_user_t), intent(out)   :: user
    logical,           intent(inout) :: error
    !
    integer(kind=4), parameter :: istart = 1
    character(len=*), parameter :: rname='AXIS>PARSE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_axis_parse_sub(line,axis%opt,istart,user,error)
    if (error) return
  end subroutine cubetools_axis_parse
  !
  subroutine cubetools_axis_parse_sub(line,opt,istart,user,error)
    !----------------------------------------------------------------------
    ! Parse axis description
    ! /AXIS n ref val inc [unit]
    !----------------------------------------------------------------------
    character(len=*),  intent(in)    :: line
    type(option_t),    intent(in)    :: opt
    integer(kind=4),   intent(in)    :: istart ! Argument number of n
    type(axis_user_t), intent(out)   :: user
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>PARSE>SUB'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    user%n    = strg_star
    user%ref  = strg_star
    user%val  = strg_star
    user%inc  = strg_star
    user%unit = strg_star
    !
    call opt%present(line,user%do,error)
    if (error) return
    if (user%do) then
       call cubetools_getarg(line,opt,istart,user%n,mandatory,error)
       if (error) return
       call cubetools_getarg(line,opt,istart+1,user%ref,mandatory,error)
       if (error) return
       call cubetools_getarg(line,opt,istart+2,user%val,mandatory,error)
       if (error) return
       call cubetools_getarg(line,opt,istart+3,user%inc,mandatory,error)
       if (error) return
       call cubetools_getarg(line,opt,istart+4,user%unit,.not.mandatory,error)
       if (error) return
    endif
  end subroutine cubetools_axis_parse_sub
  !
  subroutine cubetools_axis_user2prog(axis,user,in,ou,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(axis_opt_t), intent(in)    :: axis
    type(axis_user_t), intent(in)    :: user
    type(axis_t),      intent(in)    :: in
    type(axis_t),      intent(inout) :: ou
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>USER2PROG'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_axis_user2prog_sub(user,in,ou,error)
    if (error) return
  end subroutine cubetools_axis_user2prog
  !
  subroutine cubetools_axis_user2prog_sub(user,in,ou,error)
    use cubetools_user2prog
    !----------------------------------------------------------------------
    ! Derive the internal prog axis description from the current values and
    ! the user inputs
    !
    ! Using an equal sign strg_equal for any of these arguments indicates to use  the
    ! same  value as before.
    ! 
    ! Using a wildcard strg_star will choose an automatic default.
    !  - n is set such as the last input and output channels/pixels are
    !    aligned.
    !  - ref is set such as the first input and output channels/pixels are
    !    aligned.
    !  - val and inc are left unchanged (same as =).
    !
    ! The coordinate array may NOT be rederived if user%rederive = .false.
    ! and ou%coord is not yet associated
    !
    ! All other quantities are copied.
    !----------------------------------------------------------------------
    type(axis_user_t), intent(in)    :: user
    type(axis_t),      intent(in)    :: in
    type(axis_t),      intent(inout) :: ou
    logical,           intent(inout) :: error
    !
    logical :: reverted
    real(kind=coor_k) :: oldref,oldval,oldinc,pixval
    real(kind=coor_k) :: newref,newval,newinc,smartref
    integer(kind=pixe_k) :: oldn,newn,smartn
    type(unit_user_t) :: unit,nounit
    character(len=*), parameter :: rname='AXIS>USER2PROG>SUB'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (user%do) then
       ! Unit for reference pixel
       call nounit%get_from_code(code_unit_unk,error)
       if (error) return
       ! Unit for val and inc
       call unit%get_from_name_for_code(user%unit,in%kind,error)
       if (error) return
       oldref = in%ref
       oldval = in%val
       oldinc = in%inc
       oldn   = in%n
       ! inc
       call cubetools_user2prog_resolve_all(user%inc,unit,oldinc,oldinc,newinc,error)
       if (error) return
       if (newinc.eq.0) then
          call cubetools_message(seve%e,rname,'Resolution can not be set to 0')
          error = .true.
          return
       endif
       reverted = newinc*oldinc.lt.0.d0
       ! val
       call cubetools_user2prog_resolve_all(user%val,unit,oldval,oldval,newval,error)
       if (error) return
       ! ref
       if (reverted) then
          pixval = (oldn+0.5d0-oldref)*oldinc+oldval
       else
          pixval = (0.5d0-oldref)*oldinc+oldval
       endif
       smartref = 0.5d0-(pixval-newval)/newinc
       call cubetools_user2prog_resolve_all(user%ref,nounit,smartref,oldref,newref,error)
       if (error) return
       ! dim
       if (user%reallocate) then
          if (reverted) then
             pixval = (0.5d0-oldref)*oldinc+oldval
          else
             pixval = (oldn+0.5d0-oldref)*oldinc+oldval
          endif
          smartn = ceiling(newref-0.5d0+(pixval-newval)/newinc)
          call cubetools_user2prog_resolve_all(user%n,smartn,oldn,newn,error)
          if (error) return
       else
          newn = oldn
       endif
       !
       ! Make sure axis is properly associated
       call cubetools_axis_associate(ou,error)
       if (error) return
       ! Now transfer       
       ou%name = in%name
       ou%unit = unit%name
       ou%kind = in%kind
       ou%genuine = in%genuine
       ou%regular = in%regular
       ou%ref = newref
       ou%val = newval
       ou%inc = newinc
       ou%n   = newn
       !
       if (.not.user%reallocate .and. ou%pointeris.eq.code_pointer_null) then
          call cubetools_message(seve%e,rname,&
               'Coordinate pointer must not be null() when the programmer explicitely asks to not reallocate it')
          error = .true.
          return
       else
          call cubetools_axis_rederive(ou,error)
          if (error) return
       endif
    endif
  end subroutine cubetools_axis_user2prog_sub
  !
  subroutine cubetools_axis_sicdef(name,axis,readonly,error)
    !-------------------------------------------------------------------
    ! Define the associated SIC structure
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: name
    type(axis_t),     intent(in)    :: axis
    logical,          intent(in)    :: readonly
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>SICDEF'
    !
    call cubetools_message(toolseve%trace,rname,trim(axis%name)//' axis')
    !
    call sic_defstructure(trim(name),global,error)
    if (error) return 
    call sic_def_charn(trim(name)//'%NAME',axis%name,1,1,readonly,error)
    if (error) return
    call sic_def_charn(trim(name)//'%UNIT',axis%unit,1,1,readonly,error)
    if (error) return
    call sic_def_logi(trim(name)//'%REGULAR',axis%regular,readonly,error)
    if (error) return
    call sic_def_dble(trim(name)//'%CONV',axis%conv,1,3,readonly,error)
    if (error) return
    call sic_def_dble(trim(name)//'%INC',axis%inc,0,0,readonly,error)
    if (error) return
    call sic_def_dble(trim(name)//'%VAL',axis%val,0,0,readonly,error)
    if (error) return
    call sic_def_dble(trim(name)//'%REF',axis%ref,0,0,readonly,error)
    if (error) return
    call sic_def_dble(trim(name)//'%COORD',axis%coord,1,axis%n,readonly,error)
    if (error) return
    call sic_def_long(trim(name)//'%N',axis%n,0,0,readonly,error)
    if (error) return
  end subroutine cubetools_axis_sicdef
  !
  subroutine cubetools_axis_axis2userstruct(axis,userstruct,error)
    use cubetools_userspace
    use cubetools_userstruct
    !------------------------------------------------------------------------
    ! Ports an axis_t onto a user structure
    !------------------------------------------------------------------------
    type(axis_t),       intent(in)    :: axis
    type(userstruct_t), intent(inout) :: userstruct
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>AXIS2USERSTRUCT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call userstruct%def(error)
    if (error) return
    !
    call userstruct%set_member('name',axis%name,error)
    if (error) return
    call userstruct%set_member('unit',axis%unit,error)
    if (error) return
    call userstruct%set_member('regular',axis%regular,error)
    if (error) return
    call userstruct%set_member('conv',axis%conv,error)
    if (error) return
    call userstruct%set_member('inc',axis%inc,error)
    if (error) return
    call userstruct%set_member('val',axis%val,error)
    if (error) return
    call userstruct%set_member('ref',axis%ref,error)
    if (error) return
    call userstruct%set_member('coord',axis%coord,error)
    if (error) return
    call userstruct%set_member('n',axis%n,error)
    if (error) return
  end subroutine cubetools_axis_axis2userstruct
  !
  subroutine cubetools_axis_copy(in,ou,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    type(axis_t), intent(in)    :: in
    type(axis_t), intent(inout) :: ou
    logical,      intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>COPY'
    !
    call cubetools_message(toolseve%trace,rname,trim(in%name)//' axis')
    !
    call cubetools_axis_associate(ou,error)
    if (error) return
    call cubetools_axis_put_convert_and_derive(in%genuine,in%name,in%unit,in%kind,&
       in%n,in%conv,ou,error)
    if (error) return
  end subroutine cubetools_axis_copy
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetools_axis_consistency_init(cons,error)
    !-------------------------------------------------------------------
    ! Init the consistency between two axes
    !-------------------------------------------------------------------
    type(axis_cons_t), intent(out)   :: cons
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>CONSISTENCY>INIT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_init(notol,check,mess,cons%name,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%genuine,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%regular,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%unit,error)
    if (error) return
    call cubetools_consistency_init(notol,check,mess,cons%n,error)
    if (error) return
    call cubetools_consistency_init(strict,check,mess,cons%inc,error)
    if (error) return
    call cubetools_consistency_init(tenper,check,mess,cons%left,error)
    if (error) return
    call cubetools_consistency_init(tenper,check,mess,cons%right,error)
    if (error) return
  end subroutine cubetools_axis_consistency_init
  !
  subroutine cubetools_axis_consistency_set_tol(axtol,cons,error)
    !-------------------------------------------------------------------
    ! Set the tolerance for spatial consistency check
    !-------------------------------------------------------------------
    real(kind=tole_k), intent(in)    :: axtol
    type(axis_cons_t), intent(inout) :: cons
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>CONSISTENCY>SET>TOL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    cons%left%tol  = axtol
    cons%right%tol = axtol
  end subroutine cubetools_axis_consistency_set_tol
  !
  subroutine cubetools_axis_consistency_check(cons,axis1,axis2,error)
    !-------------------------------------------------------------------
    ! Check the consistency between two axes
    !-------------------------------------------------------------------
    type(axis_cons_t), intent(inout) :: cons
    type(axis_t),      intent(in)    :: axis1
    type(axis_t),      intent(in)    :: axis2
    logical,           intent(inout) :: error
    !
    real(kind=coor_k) :: left1,left2,right1,right2
    character(len=*), parameter :: rname='AXIS>CONSISTENCY>CHECK'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%check) return
    !
    cons%prob = .false.
    call cubetools_consistency_string_check(cons%name,axis1%name,axis2%name,error)
    if (error) return
    call cubetools_consistency_logical_check(cons%genuine,axis1%genuine,axis2%genuine,error)
    if (error) return
    call cubetools_consistency_logical_check(cons%regular,axis1%regular,axis2%regular,error)
    if (error) return
    call cubetools_consistency_string_check(cons%unit,axis1%unit,axis2%unit,error)
    if (error) return
    !
    if (axis1%regular.and.axis2%regular) then
       call cubetools_consistency_integer_check(cons%n,axis1%n,axis2%n,error)
       if (error) return
       call cubetools_consistency_real_check(cons%inc,axis1%inc,axis2%inc,error)
       if (error) return
       call cubetools_axis_pixel2offset(axis1,5d-1,left1,error)
       if (error) return
       call cubetools_axis_pixel2offset(axis2,5d-1,left2,error)
       if (error) return
       call cubetools_consistency_real_relative_check(cons%left,axis1%inc,left1,&
            axis2%inc,left2,error)
       if (error) return
       call cubetools_axis_pixel2offset(axis1,axis1%n+5d-1,right1,error)
       if (error) return
       call cubetools_axis_pixel2offset(axis2,axis2%n+5d-1,right2,error)
       if (error) return
       call cubetools_consistency_real_relative_check(cons%right,axis1%inc,right1,&
            axis2%inc,right2,error)
       if (error) return
    else
       cons%n%prob     = .false.
       cons%inc%prob   = .false.
       cons%left%prob  = .false.
       cons%right%prob = .false.
    endif
    !
    cons%prob = cons%name%prob.or.cons%genuine%prob.or.cons%regular%prob.or.cons%n%prob&
         .or.cons%inc%prob.or.cons%left%prob.or.cons%right%prob
  end subroutine cubetools_axis_consistency_check
  !
  subroutine cubetools_axis_consistency_print(label,cons,axis1,axis2,error)
    !-------------------------------------------------------------------
    ! Print the consistency between two axes
    !-------------------------------------------------------------------
    character(len=*),  intent(in)    :: label
    type(axis_cons_t), intent(in)    :: cons
    type(axis_t),      intent(in)    :: axis1
    type(axis_t),      intent(in)    :: axis2
    logical,           intent(inout) :: error
    !
    type(unit_user_t) :: unit1,unit2
    real(kind=coor_k) :: left1,left2,right1,right2
    character(len=*), parameter :: rname='AXIS>CONSISTENCY>PRINT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (.not.cons%mess) return
    !
    call cubetools_consistency_title(trim(label)//' axes',3,cons%check,cons%prob,error)
    if (error) return
    if (cons%check.and.cons%prob) then
       call cubetools_consistency_string_print('Names',cons%name,trim(axis1%name),trim(axis2%name),error)
       if (error) return
       call cubetools_consistency_logical_print('Genuine',cons%genuine,axis1%genuine,axis2%genuine,error)
       if (error) return
       call cubetools_consistency_logical_print('Regular',cons%regular,axis1%regular,axis2%regular,error)
       if (error) return
       call cubetools_consistency_string_print('Units',cons%unit,trim(axis1%unit),trim(axis2%unit),error)
       if (error) return
       if (axis1%regular.and.axis2%regular) then
          call unit1%get_from_code(axis1%kind,error)
          if (error) return
          call unit2%get_from_code(axis1%kind,error)
          if (error) return
          if (axis1%kind.eq.code_unit_unk) unit1%name = axis1%unit
          if (axis2%kind.eq.code_unit_unk) unit2%name = axis2%unit
          call cubetools_consistency_integer_print('Sizes',cons%n,axis1%n,axis2%n,error)
          if (error) return
          if (cons%unit%prob) then
             call cubetools_consistency_real_print('Increments',unit1%name,unit2%name,cons%inc,&
                  axis1%inc*unit1%user_per_prog,axis2%inc*unit2%user_per_prog,error)
             if (error) return
             call cubetools_axis_pixel2offset(axis1,5d-1,left1,error)
             if (error) return
             call cubetools_axis_pixel2offset(axis2,5d-1,left2,error)
             if (error) return
             call cubetools_consistency_real_print('Range (left) ',unit1%name,unit2%name,cons%left,&
                  left1*unit1%user_per_prog,left2*unit2%user_per_prog,error)
             if (error) return
             call cubetools_axis_pixel2offset(axis1,axis1%n+5d-1,right1,error)
             if (error) return
             call cubetools_axis_pixel2offset(axis2,axis2%n+5d-1,right2,error)
             if (error) return
             call cubetools_consistency_real_print('Range (right)',unit1%name,unit2%name,cons%right,&
                  right1*unit1%user_per_prog,right2*unit2%user_per_prog,error)
             if (error) return
          else
             call cubetools_consistency_real_print('Increments',unit1%name,cons%inc,&
                  axis1%inc*unit1%user_per_prog,axis2%inc*unit1%user_per_prog,error)
             if (error) return
             call cubetools_axis_pixel2offset(axis1,5d-1,left1,error)
             if (error) return
             call cubetools_axis_pixel2offset(axis2,5d-1,left2,error)
             if (error) return
             call cubetools_consistency_real_print('Range (left) ',unit1%name,cons%left,&
                  left1*unit1%user_per_prog,left2*unit1%user_per_prog,error)
             if (error) return
             call cubetools_axis_pixel2offset(axis1,axis1%n+5d-1,right1,error)
             if (error) return
             call cubetools_axis_pixel2offset(axis2,axis2%n+5d-1,right2,error)
             if (error) return
             call cubetools_consistency_real_print('Range (right)',unit1%name,cons%right,&
                  right1*unit1%user_per_prog,right2*unit1%user_per_prog,error)
             if (error) return
          endif
       endif
    endif
    call cubetools_message(seve%r,rname,'')
  end subroutine cubetools_axis_consistency_print
  !
  subroutine cubetools_axis_consistency_final(cons,error)
    !-------------------------------------------------------------------
    ! Final the consistency between two axes
    !-------------------------------------------------------------------
    type(axis_cons_t), intent(out)   :: cons
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>CONSISTENCY>FINAL'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_consistency_final(cons%name,error)
    if (error) return
    call cubetools_consistency_final(cons%genuine,error)
    if (error) return
    call cubetools_consistency_final(cons%regular,error)
    if (error) return
    call cubetools_consistency_final(cons%n,error)
    if (error) return
    call cubetools_consistency_final(cons%inc,error)
    if (error) return
    call cubetools_consistency_final(cons%left,error)
    if (error) return
    call cubetools_consistency_final(cons%right,error)
    if (error) return
  end subroutine cubetools_axis_consistency_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_axis_offset2pixel_indx(axis,off,ipix,error)
    !----------------------------------------------------------------------
    ! Convert an offset into the corresponding integer pixel number.
    !----------------------------------------------------------------------
    type(axis_t),         intent(in)    :: axis
    real(kind=coor_k),    intent(in)    :: off
    integer(kind=indx_k), intent(out)   :: ipix
    logical,              intent(inout) :: error
    !
    real(kind=coor_k) :: cpix
    character(len=*), parameter :: rname='AXIS>OFFSET2PIXEL>INDX'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_axis_offset2pixel_coor(axis,off,cpix,error)
    if (error) return
    ipix = nint(cpix)
    ! *** JP Make sure that the returned pixel number is inside the axis range.
    ! *** JP This could/should be splitted into two different subroutines.
    ! ipix = min(axis%n,max(1,ipix))
  end subroutine cubetools_axis_offset2pixel_indx
  !
  subroutine cubetools_axis_offset2pixel_coor(axis,off,pix,error)
    !----------------------------------------------------------------------
    ! Convert an offset into the corresponding floating point pixel number.
    !----------------------------------------------------------------------
    type(axis_t),      intent(in)    :: axis
    real(kind=coor_k), intent(in)    :: off
    real(kind=coor_k), intent(out)   :: pix
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>OFFSET2PIXEL>COOR'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if (axis%inc.ne.0.0) then
       pix = axis%ref+(off-axis%val)/axis%inc
    else
       call cubetools_message(seve%e,rname,'Increment is zero valued')
       error = .true.
       return
    endif
  end subroutine cubetools_axis_offset2pixel_coor
  !
  subroutine cubetools_axis_pixel2offset_indx(axis,pix,off,error)
    !----------------------------------------------------------------------
    ! Convert a pixel number into the corresponding offset.
    !----------------------------------------------------------------------
    type(axis_t),         intent(in)    :: axis
    integer(kind=indx_k), intent(in)    :: pix
    real(kind=coor_k),    intent(out)   :: off
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>PIXEL2OFFSET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    off = (pix-axis%ref)*axis%inc+axis%val
  end subroutine cubetools_axis_pixel2offset_indx
  !
  subroutine cubetools_axis_pixel2offset_coor(axis,pix,off,error)
    !----------------------------------------------------------------------
    ! Convert a pixel number into the corresponding offset.
    !----------------------------------------------------------------------
    type(axis_t),      intent(in)    :: axis
    real(kind=coor_k), intent(in)    :: pix
    real(kind=coor_k), intent(out)   :: off
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>PIXEL2OFFSET'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    off = (pix-axis%ref)*axis%inc+axis%val
  end subroutine cubetools_axis_pixel2offset_coor
  !
  !---------------------------------------------------------------------  
  !
  subroutine cubetools_axis_associate(axis,error)
    !-------------------------------------------------------------------
    ! Associate axis%ref, axis%val, axis%inc to one of the axis%conv(3)
    ! elements
    !-------------------------------------------------------------------
    type(axis_t), target, intent(inout) :: axis
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>ASSOCIATE'
    !
    call cubetools_message(toolseve%trace,rname,'ref,val,inc pointers for '//trim(axis%name)//' axis')
    !
    axis%ref => axis%conv(code_ref)
    axis%val => axis%conv(code_val)
    axis%inc => axis%conv(code_inc)
  end subroutine cubetools_axis_associate
  !
  subroutine cubetools_axis_put_convert(conv,axis,error)
    !-------------------------------------------------------------------
    ! Put values
    !-------------------------------------------------------------------
    real(kind=coor_k), intent(in)    :: conv(3)
    type(axis_t),      intent(inout) :: axis
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>PUT>CONVERT'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    axis%conv = conv
  end subroutine cubetools_axis_put_convert
  !
  subroutine cubetools_axis_put_refvalinc(ref,val,inc,axis,error)
    !-------------------------------------------------------------------
    ! Put values
    !-------------------------------------------------------------------
    real(kind=coor_k), intent(in)    :: ref
    real(kind=coor_k), intent(in)    :: val
    real(kind=coor_k), intent(in)    :: inc
    type(axis_t),      intent(inout) :: axis
    logical,           intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>PUT>REFVALINC'
    !
    call cubetools_message(toolseve%trace,rname,trim(axis%name)//' axis')
    !
    if (associated(axis%ref)) then
       axis%ref = ref
    else
       call cubetools_message(seve%e,rname,'axis%ref unassociated for '//trim(axis%name)//' axis')
       error = .true.
       return
    endif
    if (associated(axis%val)) then
       axis%val = val
    else
       call cubetools_message(seve%e,rname,'axis%ref unassociated for '//trim(axis%name)//' axis')
       error = .true.
       return
    endif
    if (associated(axis%inc)) then
       axis%inc = inc
    else
       call cubetools_message(seve%e,rname,'axis%ref unassociated for '//trim(axis%name)//' axis')
       error = .true.
       return
    endif
  end subroutine cubetools_axis_put_refvalinc
  !
  subroutine cubetools_axis_reallocate(n,axis,error)
    !-------------------------------------------------------------------
    ! Reallocate the axis_t array to a size of n
    !-------------------------------------------------------------------
    integer(kind=chan_k), intent(in)    :: n
    type(axis_t),         intent(inout) :: axis
    logical,              intent(inout) :: error
    !
    logical :: allocate
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='AXIS>REALLOCATE'
    !
    call cubetools_message(toolseve%trace,rname,trim(axis%name)//' axis')
    !
    allocate = .true.
    if (axis%pointeris.eq.code_pointer_allocated) then
       if (axis%n.eq.n) then
          write(mess,'(a,a,i0)') trim(axis%name),' axis already allocated at the right size: ',n
          call cubetools_message(toolseve%alloc,rname,mess)
          allocate = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',trim(axis%name),' axis already associated with a different size => Freeing it first'
          call cubetools_message(toolseve%alloc,rname,mess)
          call cubetools_axis_free(axis,error)
          if (error) return
       endif
    endif
    if (allocate) then
       allocate(axis%coord(n),stat=ier)
       if (failed_allocate(rname,axis%name,ier,error)) return
       write(mess,'(a,a,a,i0)') 'Allocated ',trim(axis%name),' axis of size: ',n
       call cubetools_message(toolseve%alloc,rname,mess)
    endif
    !
    ! Allocation success => Fill axis%n...
    axis%pointeris = code_pointer_allocated
    axis%n = n
  end subroutine cubetools_axis_reallocate
  !
  subroutine cubetools_axis_free(axis,error)
    !-------------------------------------------------------------------
    ! Free the axis_t array and nullify the pointer.
    !-------------------------------------------------------------------
    type(axis_t), intent(inout) :: axis
    logical,      intent(inout) :: error
    !
    character(len=*), parameter :: rname='AXIS>FREE'
    !
    call cubetools_message(toolseve%trace,rname,trim(axis%name)//' axis')
    !
    axis%n = 0
    if (axis%pointeris.eq.code_pointer_allocated) then
      deallocate(axis%coord)
    else
      axis%coord => null()
    endif
    axis%pointeris = code_pointer_null
  end subroutine cubetools_axis_free
  !
  subroutine cubetools_axis_final(axis)
    !-------------------------------------------------------------------
    ! Perform axis_t finalization
    !-------------------------------------------------------------------
    type(axis_t), intent(inout) :: axis
    !
    logical :: error
    !
    error = .false.
    call cubetools_axis_free(axis,error)
    if (error) return
  end subroutine cubetools_axis_final
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_axis_set_ref_to(axis,ref)
    !-------------------------------------------------------------------
    ! Set reference pixel to one while keeping the same axis description
    !-------------------------------------------------------------------
    class(axis_t),     intent(inout) :: axis
    real(kind=coor_k), intent(in)    :: ref
    !
    character(len=*), parameter :: rname='AXIS>SET>REF>TO'
    !
    axis%val = (ref-axis%ref)*axis%inc+axis%val
    axis%ref = ref
  end subroutine cubetools_axis_set_ref_to
  !
  function cubetools_axis_intersect(ax1,ax2)
    !----------------------------------------------------------------------
    ! Tests if two axes intersect
    !----------------------------------------------------------------------
    logical                  :: cubetools_axis_intersect
    type(axis_t), intent(in) :: ax1
    type(axis_t), intent(in) :: ax2
    !
    real(kind=coor_k) :: xr1,xr2,is1,is2
    integer(kind=chan_k) :: ochanmin,ochanmax 
    !
    xr1 = (   1.-ax1%ref)*ax1%inc+ax1%val
    xr2 = (ax1%n-ax1%ref)*ax1%inc+ax1%val
    is1 = (xr1-ax2%val)/ax2%inc+ax2%ref  
    is2 = (xr2-ax2%val)/ax2%inc+ax2%ref
    if (is1.lt.is2) then
       ochanmin = nint(is1)
       ochanmax = nint(is2)
    else
       ochanmin = nint(is2)
       ochanmax = nint(is1)
    endif
    !
    cubetools_axis_intersect = .not.(ochanmin.gt.ax2%n.or.ochanmax.lt.1)
  end function cubetools_axis_intersect
  !
  function cubetools_axis_inside_chan(axis,ix) result(inside)
    !----------------------------------------------------------------------
    ! Tests if ix is inside the axis range
    ! This version with integer value based on 'channel' numbering
    !----------------------------------------------------------------------
    class(axis_t),        intent(in) :: axis
    integer(kind=chan_k), intent(in) :: ix
    logical                          :: inside
    !
    inside = (1.le.ix).and.(ix.le.axis%n)
  end function cubetools_axis_inside_chan
  !
  function cubetools_axis_inside_coord(axis,val) result(inside)
    !----------------------------------------------------------------------
    ! Tests if ix is inside the axis range
    ! This version with real value based on 'coord' values
    !----------------------------------------------------------------------
    class(axis_t),     intent(inout) :: axis
    real(kind=coor_k), intent(in)    :: val
    logical                          :: inside
    !
    ! Boundaries are excluded (.lt. comparison). This is conversative
    ! to avoid later issues, in particular with some nint() conversion
    ! to pixel integer value later on, when this function says the
    ! coordinate is inside but nint() returns a pixel number outside.
    inside = (axis%get_min().lt.val).and.(val.lt.axis%get_max())
  end function cubetools_axis_inside_coord
end module cubetools_axis_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
