!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetools_header_interface
  use gbl_constant
  use cubetools_parameters
  use cubetools_messaging
  use cubetools_observatory_types
  use cubetools_unit
  !
  public :: code_spectral_unknown,code_spectral_frequency,code_spectral_wavelength
  public :: code_systemic_unknown,code_systemic_velocity,code_systemic_redshift
  !
  public :: nspeconv,speconvnames
  public :: code_speconv_unknown,code_speconv_radio,code_speconv_optical,code_speconv_relativistic
  !
  public :: speframes,nspeframes
  public :: code_speframe_unknown,code_speframe_lsrk,code_speframe_helio,code_speframe_obser,code_speframe_earth
  !
  public :: spaframes,nspaframes
  public :: code_spaframe_unknown,code_spaframe_equatorial,code_spaframe_galactic,code_spaframe_horizontal,code_spaframe_icrs
  !
  public :: cube_header_interface_t
  !
  public :: cubetools_convert_spaframe2code,cubetools_convert_code2spaframe
  private
  !
  integer(kind=4),      parameter :: nspectrals = 3
  character(len=*),     parameter :: spectrals(nspectrals) = ['UNKNOWN   ','FREQUENCY ','WAVELENGTH']
  integer(kind=code_k), parameter :: code_spectral_unknown    = 1
  integer(kind=code_k), parameter :: code_spectral_frequency  = 2
  integer(kind=code_k), parameter :: code_spectral_wavelength = 3
  !
  integer(kind=4),      parameter :: nsystemics = 3
  character(len=*),     parameter :: systemics(nsystemics) = ['UNKNOWN ','VELOCITY','REDSHIFT']
  integer(kind=code_k), parameter :: code_systemic_unknown  = 1
  integer(kind=code_k), parameter :: code_systemic_velocity = 2
  integer(kind=code_k), parameter :: code_systemic_redshift = 3
  !
  integer(kind=4),       parameter :: nspeframes = 5
  character(len=fram_l), parameter :: speframes(nspeframes) = ['Unk ','LSRK','Hel ','Obs ','Ear ']
  integer(kind=code_k),  parameter :: code_speframe_unknown = vel_unk+1 ! 1
  integer(kind=code_k),  parameter :: code_speframe_lsrk    = vel_lsr+1 ! 2
  integer(kind=code_k),  parameter :: code_speframe_helio   = vel_hel+1 ! 3
  integer(kind=code_k),  parameter :: code_speframe_obser   = vel_obs+1 ! 4
  integer(kind=code_k),  parameter :: code_speframe_earth   = vel_ear+1 ! 5
  !
  integer(kind=4),       parameter :: nspeconv = 4
  character(len=conv_l), parameter :: speconvnames(nspeconv) = ['Unknown','Radio  ','Optical','Relativ']
  integer(kind=code_k),  parameter :: code_speconv_unknown      = vconv_unk+1 ! 1
  integer(kind=code_k),  parameter :: code_speconv_radio        = vconv_rad+1 ! 2
  integer(kind=code_k),  parameter :: code_speconv_optical      = vconv_opt+1 ! 3
  integer(kind=code_k),  parameter :: code_speconv_relativistic = 4           ! 4
  !
  integer(kind=4),       parameter :: nspaframes = 5
  character(len=fram_l), parameter :: spaframes(nspaframes) = ['UNKNOWN   ','EQUATORIAL','GALACTIC  ','HORIZONTAL','ICRS      ']
  integer(kind=code_k),  parameter :: code_spaframe_unknown    = type_un ! 1
  integer(kind=code_k),  parameter :: code_spaframe_equatorial = type_eq ! 2
  integer(kind=code_k),  parameter :: code_spaframe_galactic   = type_ga ! 3
  integer(kind=code_k),  parameter :: code_spaframe_horizontal = type_ho ! 4
  integer(kind=code_k),  parameter :: code_spaframe_icrs       = type_ic ! 5
  !
  ! All non-redundant information about a header
  type cube_header_interface_t
     character(len=unit_l) :: axset_name(maxdim) = strg_unk      ! Axis name
     character(len=unit_l) :: axset_unit(maxdim) = strg_unk      ! Axis unit
     integer(kind=code_k)  :: axset_kind(maxdim) = code_unit_unk ! Axis kind for unit conversion
     integer(kind=ndim_k)  :: axset_ndim = 0                     ! Actual number of axes
     integer(kind=data_k)  :: axset_dim(maxdim) = 0              ! Number of coordinates along each axis
     real(kind=coor_k)     :: axset_convert(3,maxdim) = 0d0      ! Axis definition for regularly spaced array
     integer(kind=ndim_k)  :: axset_ix = code_unk                ! 1st spatial axis
     integer(kind=ndim_k)  :: axset_iy = code_unk                ! 2nd spatial axis
     integer(kind=ndim_k)  :: axset_ic = code_unk                ! Spectral axis   
     !
     integer(kind=code_k)  :: array_type = code_unk    ! [---] Type of data (e.g., REAL*4)
     character(len=unit_l) :: array_unit = strg_unk    ! [---] Unit
     real(kind=sign_k)     :: array_minval = 0.0       ! [***] Minimum value
     integer(kind=data_k)  :: array_minloc(maxdim) = 0 ! [pix] Minimum location
     real(kind=sign_k)     :: array_maxval = 0.0       ! [***] Maximum value
     integer(kind=data_k)  :: array_maxloc(maxdim) = 0 ! [pix] Maximum location
     real(kind=sign_k)     :: array_noise = 0.0        ! [***] Theoretical noise
     real(kind=sign_k)     :: array_rms = 0.0          ! [***] Measured noise
     integer(kind=data_k)  :: array_nan = 0            ! [pix] Number of NaN elements
     !
     ! None of the following information are redundant with axset
     ! because the spatial axes may not be defined but the spatial
     ! information still be relevant...
     character(len=argu_l) :: spatial_source = strg_unk                  ! [---] Source name
     integer(kind=code_k)  :: spatial_frame_code = code_spaframe_unknown ! [---] Reference frame code
     real(kind=equi_k)     :: spatial_frame_equinox = 0.0                ! [---] Reference frame equinox, when relevant
     integer(kind=code_k)  :: spatial_projection_code = code_unk         ! [---] Projection code
     real(kind=coor_k)     :: spatial_projection_l0 = 0d0                ! [rad] Projection center
     real(kind=coor_k)     :: spatial_projection_m0 = 0d0                ! [rad] Projection center
     real(kind=coor_k)     :: spatial_projection_pa = 0d0                ! [rad] Projection position angle
     real(kind=beam_k)     :: spatial_beam_major = 0.0                   ! [rad] Beam major axis size
     real(kind=beam_k)     :: spatial_beam_minor = 0.0                   ! [rad] Beam minor axis size
     real(kind=beam_k)     :: spatial_beam_pa = 0.0                      ! [rad] beam position angle
     !
     ! None of the following information are redundant with axset
     ! because the spectral axis may not be defined but the spectral
     ! information still be relevant...
     integer(kind=code_k)  :: spectral_frame_code = code_speframe_unknown    ! [--------] Frame of reference
     integer(kind=code_k)  :: spectral_convention = code_speconv_unknown     ! [--------] Convention for velocity or redshift
     character(len=line_l) :: spectral_line = strg_unk                       ! [--------] Name of the line
     integer(kind=code_k)  :: spectral_code = code_spectral_unknown          ! [--------] frequency or wavelenght
     real(kind=coor_k)     :: spectral_increment_value = 0d0                 ! [ MHz|mum] Frequency or wavelenght
     real(kind=coor_k)     :: spectral_signal_value = 0d0                    ! [ MHz|mum] Signal value
     real(kind=coor_k)     :: spectral_image_value = 0d0                     ! [ MHz|mum] Image  value
     integer(kind=code_k)  :: spectral_systemic_code = code_systemic_unknown ! [--------] Systemic description: velocity or redshift
     real(kind=coor_k)     :: spectral_systemic_value = 0d0                  ! [km/s|Red] Systemic value
     !
     ! Observatory section
     type(observatory_t)   :: obs
     !
     ! non-regular axis
     ! *** JP question: What should we store here?
     !
   contains
     procedure :: init      => cubetools_header_interface_init
     procedure :: create    => cubetools_header_interface_create
     procedure :: list      => cubetools_header_interface_list
     procedure :: transpose => cubetools_header_interface_transpose
     procedure :: to_struct => cubetools_header_interface_to_struct
     procedure :: write     => cubetools_header_interface_write
     procedure :: read      => cubetools_header_interface_read
  end type cube_header_interface_t
  !
  integer(kind=4), parameter :: key_l=24  ! Note the T26 tab below
  character(len=*), parameter :: form_i4='(A,T26,32(I11))'       ! Scalar or array I*4
  character(len=*), parameter :: form_i8='(A,T26,32(I20))'       ! Scalar or array I*8
  character(len=*), parameter :: form_r4='(A,T26,32(1PG15.7))'   ! Scalar or array R*4
  character(len=*), parameter :: form_r8='(A,T26,32(1PG25.16))'  ! Scalar or array R*8
  character(len=*), parameter :: form_a ='(A,T26,32(1X,A12))'    ! Scalar or array string
  !
contains
  !
  subroutine cubetools_header_interface_init(head,error)
    use cubetools_nan
    !-------------------------------------------------------------------
    ! (Re)initialize the cube_header_interface_t elements, including
    ! deallocation of allocatables, if any.
    ! NB1: This would not behave as expected if allocatable pointers are
    ! added in the type.
    ! NB2: this subroutine puts NaN values where relevant, while the
    ! type initializations do not.
    !-------------------------------------------------------------------
    class(cube_header_interface_t), intent(out)   :: head
    logical,                        intent(inout) :: error
    !
    head%array_minval = gr4nan
    head%array_maxval = gr4nan
    head%array_noise = gr4nan
    head%array_rms = gr4nan
    !
    head%spatial_beam_major = gr4nan
    head%spatial_beam_minor = gr4nan
    head%spatial_beam_pa = gr4nan
  end subroutine cubetools_header_interface_init
  !
  subroutine cubetools_header_interface_create(head,type,access,ndim,dim,error)
    use cubetools_nan
    !-------------------------------------------------------------------
    ! Create a header from scratch
    !-------------------------------------------------------------------
    class(cube_header_interface_t), intent(out)   :: head
    integer(kind=code_k),           intent(in)    :: type
    integer(kind=code_k),           intent(in)    :: access
    integer(kind=ndim_k),           intent(in)    :: ndim
    integer(kind=data_k),           intent(in)    :: dim(:)
    logical,                        intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>INTERFACE>CREATE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call head%init(error)
    if (error) return
    head%array_type = type
    select case (access)
    case (code_access_imaset)
       head%axset_ix = 1
       head%axset_iy = 2
       head%axset_ic = 3
    case (code_access_speset)
       head%axset_ic = 1
       head%axset_ix = 2
       head%axset_iy = 3
    end select
    if ((ndim.lt.1).or.(maxdim.lt.ndim)) then
       call cubetools_message(seve%e,rname,'Number of dimension outside authorized range')
       error = .true.
       return
    endif
    head%axset_ndim = ndim
    head%axset_dim(1:ndim) = dim(1:ndim)
    ! We are using the Fourier convention, i.e., for an axis of size
    ! 2n, the axis center is at reference n+1. This is the same done
    ! in MAPPING when computing the Dirty image. However in MAPPING an
    ! odd number of pixels is forbidden due to the constraints on the
    ! FFTs.
    head%axset_convert(1,1:ndim) = 0.5d0*dim+1.0d0
    head%axset_convert(2,1:ndim) = 0.0d0
    head%axset_convert(3,1:ndim) = 1.0d0
    !
    head%axset_name(head%axset_ix) = 'X'
    head%axset_name(head%axset_iy) = 'Y'
    head%axset_name(head%axset_ic) = 'C'
    head%axset_kind(head%axset_ix) = code_unit_pixe
    head%axset_kind(head%axset_iy) = code_unit_pixe
    head%axset_kind(head%axset_ic) = code_unit_chan
  end subroutine cubetools_header_interface_create
  !
  subroutine cubetools_header_interface_list(head,error)
    use cubetools_format
    use cubetools_observatory_types
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(cube_header_interface_t), intent(in)    :: head
    logical,                        intent(inout) :: error
    !
    integer(kind=ndim_k) :: iaxis
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='HEADER>INTERFACE>LIST'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_message(seve%r,rname,' ')
    mess = cubetools_format_stdkey_boldval('NDIM',head%axset_ndim,'i3',9)
    mess = trim(mess)//'   '//cubetools_format_stdkey_boldval('IX',head%axset_ix,'i3',9)
    mess = trim(mess)//'   '//cubetools_format_stdkey_boldval('IY',head%axset_iy,'i3',9)
    mess = trim(mess)//'   '//cubetools_format_stdkey_boldval('IC',head%axset_ic,'i3',9)
    call cubetools_message(seve%r,rname,mess)
    !
    call cubetools_message(seve%r,rname,' ')
    do iaxis = 1,maxdim
       write(mess,'(i2)') iaxis
       mess = trim(mess)//' '//cubetools_format_stdkey_boldval(head%axset_name(iaxis),head%axset_dim(iaxis),'i5',18)
       mess = trim(mess)//' '//cubetools_format_stdkey_boldval('',head%axset_convert(1,iaxis),fdouble,ndouble)
       mess = trim(mess)//' '//cubetools_format_stdkey_boldval('',head%axset_convert(2,iaxis),fdouble,ndouble)
       mess = trim(mess)//' '//cubetools_format_stdkey_boldval('',head%axset_convert(3,iaxis),fdouble,ndouble)
       mess = trim(mess)//' '//cubetools_format_stdkey_boldval('',head%axset_unit(iaxis),12)
       call cubetools_message(seve%r,rname,mess)
!!$     head%axset_kind(maxdim)
!!$ 
    enddo ! iaxis
    !
    call cubetools_message(seve%r,rname,' ')
    mess = cubetools_format_stdkey_boldval('SOUR',head%spatial_source,17)
    call cubetools_message(seve%r,rname,mess)
    mess = cubetools_format_stdkey_boldval('FRAMECODE',head%spatial_frame_code,'i3',17)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('EQUINOX',head%spatial_frame_equinox,'f7.2',22)
    call cubetools_message(seve%r,rname,mess)
    !
    mess = cubetools_format_stdkey_boldval('PROJECODE',head%spatial_projection_code,'i3',17)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('L0',head%spatial_projection_l0,fdouble,ndouble+3)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('M0',head%spatial_projection_m0,fdouble,ndouble+3)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('PA',head%spatial_projection_pa,fdouble,ndouble+3)
    call cubetools_message(seve%r,rname,mess)
    !
    mess = cubetools_format_stdkey_boldval('BEAM','',17)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('MAJ',head%spatial_beam_major,fdouble,ndouble+3)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('MIN',head%spatial_beam_minor,fdouble,ndouble+3)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('PA',head%spatial_beam_pa,fdouble,ndouble+3)
    call cubetools_message(seve%r,rname,mess)
    !
    call cubetools_message(seve%r,rname,' ')
    mess = cubetools_format_stdkey_boldval('LINE',head%spectral_line,17)
    call cubetools_message(seve%r,rname,mess)
    mess = cubetools_format_stdkey_boldval('FRAMECODE',head%spectral_frame_code,'i3',17)
    mess = cubetools_format_stdkey_boldval('CONVECODE',head%spectral_convention,'i3',17)
    call cubetools_message(seve%r,rname,mess)
    !
    mess = cubetools_format_stdkey_boldval('AXISKIND',head%spectral_code,'i3',17)
    mess = trim(mess)//' '//cubetools_format_stdkey_boldval('INC',head%spectral_increment_value,fdouble,ndouble+3)
    mess = trim(mess)//' '//cubetools_format_stdkey_boldval('SIG',head%spectral_signal_value,fdouble,ndouble+3)
    mess = trim(mess)//' '//cubetools_format_stdkey_boldval('IMA',head%spectral_image_value,fdouble,ndouble+3)
    call cubetools_message(seve%r,rname,mess)
    !
    mess = cubetools_format_stdkey_boldval('SYSTCODE',head%spectral_systemic_code,'i3',17)
    mess = trim(mess)//' '//cubetools_format_stdkey_boldval('VAL',head%spectral_systemic_value,fdouble,ndouble+3)
    call cubetools_message(seve%r,rname,mess)
    !
    call cubetools_observatory_list(head%obs,error)
    if (error) return
  end subroutine cubetools_header_interface_list
  !
  subroutine cubetools_header_interface_transpose(head,tr,error)
    !-------------------------------------------------------------------
    ! Transpose inplace the interface to new order, according to
    ! the transposition array.
    ! For example: tr = [3,1,2]  => 3rd dimension moved first
    !-------------------------------------------------------------------
    class(cube_header_interface_t), intent(inout) :: head
    integer(kind=ndim_k),           intent(in)    :: tr(:)
    logical,                        intent(inout) :: error
    !
    type(cube_header_interface_t) :: tmp
    integer(kind=ndim_k) :: idim
    !
    ! Duplicate elements which are to be transposed
    tmp%axset_name(:)      = head%axset_name(:)
    tmp%axset_unit(:)      = head%axset_unit(:)
    tmp%axset_kind(:)      = head%axset_kind(:)
    tmp%axset_dim(:)       = head%axset_dim(:)
    tmp%axset_convert(:,:) = head%axset_convert(:,:)
    tmp%axset_ix           = head%axset_ix
    tmp%axset_iy           = head%axset_iy
    tmp%axset_ic           = head%axset_ic
    tmp%array_minloc(:)    = head%array_minloc(:)
    tmp%array_maxloc(:)    = head%array_maxloc(:)
    !
    ! Transpose
    do idim=1,size(tr)
      head%axset_name(idim)      = tmp%axset_name(tr(idim))
      head%axset_unit(idim)      = tmp%axset_unit(tr(idim))
      head%axset_kind(idim)      = tmp%axset_kind(tr(idim))
      head%axset_dim(idim)       = tmp%axset_dim(tr(idim))
      head%axset_convert(:,idim) = tmp%axset_convert(:,tr(idim))
      if (tmp%axset_ix.eq.tr(idim))  head%axset_ix = idim
      if (tmp%axset_iy.eq.tr(idim))  head%axset_iy = idim
      if (tmp%axset_ic.eq.tr(idim))  head%axset_ic = idim
      head%array_minloc(idim)    = tmp%array_minloc(tr(idim))
      head%array_maxloc(idim)    = tmp%array_maxloc(tr(idim))
    enddo ! idim
  end subroutine cubetools_header_interface_transpose
  !
  subroutine cubetools_header_interface_to_struct(head,struct,error)
    use cubetools_userspace
    use cubetools_userstruct
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Load Interface onto a SIC structure
    ! The fortran type is flat on purpose. We here introduce substructures
    ! to ease user life.
    ! *** JP SIC names change compared to fortran names because of current
    ! *** JP work to go to VO. At some point the fortran variables should/will
    ! *** JP be renamed.
    !-------------------------------------------------------------------
    class(cube_header_interface_t), intent(in)    :: head
    class(userspace_t),             intent(inout) :: struct
    logical,                        intent(inout) :: error
    !
    character(len=argu_l) :: projections(0:mproj)
    type(userstruct_t) :: interf,axset,array,obs
    type(userstruct_t) :: spatial,spaframe,spaproj,spabeam
    type(userstruct_t) :: spectral,speline,spelinerest,spelinedopp
    character(len=*), parameter :: rname='INTERFACE>TO>STRUCT'
    !
    select type(struct)
    type is (userstruct_t)
       call struct%def_substruct('cube',interf,error)
       if (error) return
       ! Description of axes
       call interf%def_substruct('axset',axset,error)
       if (error) return 
       call axset%set_member('name',head%axset_name,error)
       if (error) return
       call axset%set_member('unit',head%axset_unit,error)
       if (error) return
       call axset%set_member('kind',head%axset_kind,error)
       if (error) return
       call axset%set_member('ndim',head%axset_ndim,error)
       if (error) return
       call axset%set_member('dim',head%axset_dim,error)
       if (error) return
       call axset%set_member('convert',head%axset_convert,error)
       if (error) return
       call axset%set_member('ix',head%axset_ix,error)
       if (error) return
       call axset%set_member('iy',head%axset_iy,error)
       if (error) return
       call axset%set_member('ic',head%axset_ic,error)
       if (error) return
       ! Description of the array
       call interf%def_substruct('array',array,error)
       if (error) return
       call array%set_member('type',head%array_type,error)
       if (error) return
       call array%set_member('unit',head%array_unit,error)
       if (error) return
       call array%set_member('minval',head%array_minval,error)
       if (error) return
       call array%set_member('minloc',head%array_minloc,error)
       if (error) return
       call array%set_member('maxval',head%array_maxval,error)
       if (error) return
       call array%set_member('maxloc',head%array_maxloc,error)
       if (error) return
       call array%set_member('noise',head%array_noise,error)
       if (error) return
       call array%set_member('rms',head%array_rms,error)
       if (error) return
       call array%set_member('nan',head%array_nan,error)
       if (error) return
       ! Spatial coordinates
       call interf%def_substruct('spatial',spatial,error)
       if (error) return
       call spatial%set_member('source',head%spatial_source,error)
       if (error) return
       ! Spatial frame
       call spatial%def_substruct('frame',spaframe,error)
       if (error) return
       call spaframe%set_member('kind',spaframes(head%spatial_frame_code),error)
       if (error) return
       call spaframe%set_member('equinox',head%spatial_frame_equinox,error)
       if (error) return
       ! Spatial projection
       call projnam_list(projections)
       call spatial%def_substruct('projection',spaproj,error)
       if (error) return
       call spaproj%set_member('kind',projections(head%spatial_projection_code),error)
       if (error) return
       call spaproj%set_member('l0',head%spatial_projection_l0,error)
       if (error) return
       call spaproj%set_member('m0',head%spatial_projection_m0,error)
       if (error) return
       call spaproj%set_member('pa',head%spatial_projection_pa,error)
       if (error) return
       ! Spatial beam
       call spatial%def_substruct('beam',spabeam,error)
       if (error) return
       call spabeam%set_member('major',head%spatial_beam_major,error)
       if (error) return
       call spabeam%set_member('minor',head%spatial_beam_minor,error)
       if (error) return
       call spabeam%set_member('pa',head%spatial_beam_pa,error)
       if (error) return
       ! Spectral coordinates
       call interf%def_substruct('spectral',spectral,error)
       if (error) return
       ! Spectral frame
       call spectral%set_member('framekind',speframes(head%spectral_frame_code),error)
       if (error) return
       ! Spectral line description: properties in rest frame and doppler effect
       call spectral%def_substruct('line',speline,error)
       if (error) return
       call speline%set_member('name',head%spectral_line,error)
       if (error) return
       call speline%def_substruct('rest',spelinerest,error)
       if (error) return
       call spelinerest%set_member('kind',spectrals(head%spectral_code),error)
       if (error) return
       call spelinerest%set_member('resolution',head%spectral_increment_value,error)
       if (error) return
       call spelinerest%set_member('signal',head%spectral_signal_value,error)
       if (error) return
       call spelinerest%set_member('image',head%spectral_image_value,error)
       if (error) return
       call speline%def_substruct('doppler',spelinedopp,error)
       if (error) return
       call spelinedopp%set_member('convention',speconvnames(head%spectral_convention),error)
       if (error) return
       call spelinedopp%set_member('kind',systemics(head%spectral_systemic_code),error)
       if (error) return
       call spelinedopp%set_member('value',head%spectral_systemic_value,error)
       if (error) return
       ! Observatory
       call interf%def_substruct('obs',obs,error)
       if (error) return
       call cubetools_observatory_obs2userstruct(head%obs,obs,error)
       if (error) return
    class default
       call cubetools_message(seve%e,rname,'Internal error: object has wrong type')
       error = .true.
       return
    end select
  end subroutine cubetools_header_interface_to_struct
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_convert_spaframe2code(spaframe,code,error)
    use cubetools_disambiguate
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*),     intent(in)    :: spaframe
    integer(kind=code_k), intent(out)   :: code
    logical,              intent(inout) :: error
    !
    character(len=fram_l) :: frame
    character(len=*), parameter :: rname='CONVERT>SPAFRAME2CODE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_disambiguate_strict(spaframe,spaframes,code,frame,error)
    if (error)  return
  end subroutine cubetools_convert_spaframe2code
  !
  subroutine cubetools_convert_code2spaframe(code,spaframe,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: code
    character(len=*),     intent(out)   :: spaframe
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONVERT>CODE2SPAFRAME'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if ((1.le.code).or.(code.le.nspaframes)) then
       spaframe = spaframes(code)
    else
       call cubetools_message(seve%e,rname,'Unknown spatial frame code')
       error = .true.
       return
    endif
  end subroutine cubetools_convert_code2spaframe
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetools_convert_speframe2code(speframe,code,error)
    use cubetools_disambiguate
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    character(len=*),     intent(in)    :: speframe
    integer(kind=code_k), intent(out)   :: code
    logical,              intent(inout) :: error
    !
    character(len=fram_l) :: frame
    character(len=*), parameter :: rname='CONVERT>SPEFRAME2CODE'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    call cubetools_disambiguate_strict(speframe,speframes,code,frame,error)
    if (error)  return
  end subroutine cubetools_convert_speframe2code
  !
  subroutine cubetools_convert_code2speframe(code,speframe,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: code
    character(len=*),     intent(out)   :: speframe
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='CONVERT>CODE2SPEFRAME'
    !
    call cubetools_message(toolseve%trace,rname,'Welcome')
    !
    if ((1.le.code).or.(code.le.nspeframes)) then
       speframe = speframes(code)
    else
       call cubetools_message(seve%e,rname,'Unknown spetial frame code')
       error = .true.
       return
    endif
  end subroutine cubetools_convert_code2speframe
  !
  subroutine cubetools_header_interface_write(head,lun,error)
    !-------------------------------------------------------------------
    ! Write the interface to the given logical unit
    !-------------------------------------------------------------------
    class(cube_header_interface_t), intent(in)    :: head
    integer(kind=4),                intent(in)    :: lun
    logical,                        intent(inout) :: error
    !
    write(lun,form_a)  'AXSET_NAME',   head%axset_name(:)
    write(lun,form_a)  'AXSET_UNIT',   head%axset_unit(:)
    write(lun,form_i4) 'AXSET_KIND',   head%axset_kind(:)
    write(lun,form_i4) 'AXSET_NDIM',   head%axset_ndim
    write(lun,form_i8) 'AXSET_DIM',    head%axset_dim(:)
    write(lun,form_r8) 'AXSET_CONVERT',head%axset_convert(:,:)
    write(lun,form_i4) 'AXSET_IX',     head%axset_ix
    write(lun,form_i4) 'AXSET_IY',     head%axset_iy
    write(lun,form_i4) 'AXSET_IC',     head%axset_ic
    !
    write(lun,form_i4) 'ARRAY_TYPE',  head%array_type
    write(lun,form_a)  'ARRAY_UNIT',  head%array_unit
    write(lun,form_r4) 'ARRAY_MINVAL',head%array_minval
    write(lun,form_i8) 'ARRAY_MINLOC',head%array_minloc(:)
    write(lun,form_r4) 'ARRAY_MAXVAL',head%array_maxval
    write(lun,form_i8) 'ARRAY_MAXLOC',head%array_maxloc(:)
    write(lun,form_r4) 'ARRAY_NOISE', head%array_noise
    write(lun,form_r4) 'ARRAY_RMS',   head%array_rms
    write(lun,form_i8) 'ARRAY_NAN',   head%array_nan
    !
    write(lun,form_a)  'SPATIAL_SOURCE',         head%spatial_source
    write(lun,form_i4) 'SPATIAL_FRAME_CODE',     head%spatial_frame_code
    write(lun,form_r4) 'SPATIAL_FRAME_EQUINOX',  head%spatial_frame_equinox
    write(lun,form_i4) 'SPATIAL_PROJECTION_CODE',head%spatial_projection_code
    write(lun,form_r8) 'SPATIAL_PROJECTION_L0',  head%spatial_projection_l0
    write(lun,form_r8) 'SPATIAL_PROJECTION_M0',  head%spatial_projection_m0
    write(lun,form_r8) 'SPATIAL_PROJECTION_PA',  head%spatial_projection_pa
    write(lun,form_r4) 'SPATIAL_BEAM_MAJOR',     head%spatial_beam_major
    write(lun,form_r4) 'SPATIAL_BEAM_MINOR',     head%spatial_beam_minor
    write(lun,form_r4) 'SPATIAL_BEAM_PA',        head%spatial_beam_pa
    !
    write(lun,form_i4) 'SPECTRAL_FRAME_CODE',     head%spectral_frame_code
    write(lun,form_i4) 'SPECTRAL_CONVENTION',     head%spectral_convention
    write(lun,form_a)  'SPECTRAL_LINE',           head%spectral_line
    write(lun,form_i4) 'SPECTRAL_CODE',           head%spectral_code
    write(lun,form_r8) 'SPECTRAL_INCREMENT_VALUE',head%spectral_increment_value
    write(lun,form_r8) 'SPECTRAL_SIGNAL_VALUE',   head%spectral_signal_value
    write(lun,form_r8) 'SPECTRAL_IMAGE_VALUE',    head%spectral_image_value
    write(lun,form_i4) 'SPECTRAL_SYSTEMIC_CODE',  head%spectral_systemic_code
    write(lun,form_r8) 'SPECTRAL_SYSTEMIC_VALUE', head%spectral_systemic_value
    !
    call head%obs%write(lun,error)
    if (error)  return
    !
  end subroutine cubetools_header_interface_write
  !
  subroutine cubetools_header_interface_read(head,lun,error)
    !-------------------------------------------------------------------
    ! Read the interface from the given logical unit
    !-------------------------------------------------------------------
    class(cube_header_interface_t), intent(inout) :: head
    integer(kind=4),                intent(in)    :: lun
    logical,                        intent(inout) :: error
    !
    character(len=key_l) :: key
    !
    read(lun,form_a)  key,head%axset_name(:)
    read(lun,form_a)  key,head%axset_unit(:)
    read(lun,form_i4) key,head%axset_kind(:)
    read(lun,form_i4) key,head%axset_ndim
    read(lun,form_i8) key,head%axset_dim(:)
    read(lun,form_r8) key,head%axset_convert(:,:)
    read(lun,form_i4) key,head%axset_ix
    read(lun,form_i4) key,head%axset_iy
    read(lun,form_i4) key,head%axset_ic
    !
    read(lun,form_i4) key,head%array_type
    read(lun,form_a)  key,head%array_unit
    read(lun,form_r4) key,head%array_minval
    read(lun,form_i8) key,head%array_minloc(:)
    read(lun,form_r4) key,head%array_maxval
    read(lun,form_i8) key,head%array_maxloc(:)
    read(lun,form_r4) key,head%array_noise
    read(lun,form_r4) key,head%array_rms
    read(lun,form_i8) key,head%array_nan
    !
    read(lun,form_a)  key,head%spatial_source
    read(lun,form_i4) key,head%spatial_frame_code
    read(lun,form_r4) key,head%spatial_frame_equinox
    read(lun,form_i4) key,head%spatial_projection_code
    read(lun,form_r8) key,head%spatial_projection_l0
    read(lun,form_r8) key,head%spatial_projection_m0
    read(lun,form_r8) key,head%spatial_projection_pa
    read(lun,form_r4) key,head%spatial_beam_major
    read(lun,form_r4) key,head%spatial_beam_minor
    read(lun,form_r4) key,head%spatial_beam_pa
    !
    read(lun,form_i4) key,head%spectral_frame_code
    read(lun,form_i4) key,head%spectral_convention
    read(lun,form_a)  key,head%spectral_line
    read(lun,form_i4) key,head%spectral_code
    read(lun,form_r8) key,head%spectral_increment_value
    read(lun,form_r8) key,head%spectral_signal_value
    read(lun,form_r8) key,head%spectral_image_value
    read(lun,form_i4) key,head%spectral_systemic_code
    read(lun,form_r8) key,head%spectral_systemic_value
    !
    call head%obs%read(lun,error)
    if (error)  return
  end subroutine cubetools_header_interface_read
end module cubetools_header_interface
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  
