!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeio_header_hfits
  use cubetools_header_types
  use cubetools_header_interface
  use cubefitsio_header
  use cubeio_interface
  use cubeio_messaging
  !
  integer(kind=code_k), parameter :: velref_convention_optical=0
  integer(kind=code_k), parameter :: velref_convention_radio=256
  !
  integer(kind=code_k), parameter :: velref_frame_lsrk=1
  integer(kind=code_k), parameter :: velref_frame_helio=2
  integer(kind=code_k), parameter :: velref_frame_obs=3
  !
  character(len=1), parameter :: telescop_separator='+'
  !
  public :: cubeio_header_get_and_derive_fromhfits,cubeio_header_put_tohfits
  public :: cubeio_hfits_export
  private
  !
contains
  !
  subroutine cubeio_header_get_and_derive_fromhfits(hfits,head,error)
    !-------------------------------------------------------------------
    ! From type(fitsio_header_t) to type(cube_header_t)
    !-------------------------------------------------------------------
    type(fitsio_header_t), intent(in)    :: hfits
    type(cube_header_t),   intent(inout) :: head
    logical,               intent(inout) :: error
    !
    type(cube_header_interface_t) :: interface
    character(len=*), parameter :: rname='HEADER>GET>AND>DERIVE'
    !
    call cubeio_message(ioseve%trace,rname,'Welcome')
    !
    call cubeio_hfits_export(hfits,interface,error)
    if (error) return
    call cubetools_header_import_and_derive(interface,head,error)
    if (error) return
  end subroutine cubeio_header_get_and_derive_fromhfits
  !
  subroutine cubeio_header_put_tohfits(head,order,hfits,verbose,error)
    !-------------------------------------------------------------------
    ! From type(cube_header_t) to type(fitsio_header_t) with desired
    ! order
    !-------------------------------------------------------------------
    type(cube_header_t),   intent(in)    :: head
    integer(kind=code_k),  intent(in)    :: order  ! code_order_*
    type(fitsio_header_t), intent(inout) :: hfits
    logical,               intent(in)    :: verbose
    logical,               intent(inout) :: error
    !
    type(cube_header_interface_t) :: interface
    character(len=*), parameter :: rname='HEADER>PUT'
    !
    call cubeio_message(ioseve%trace,rname,'Welcome')
    !
    call cubetools_header_export(head,interface,error)
    if (error) return
    call cubeio_interface_transpose(interface,order,error)
    if (error) return
    call cubeio_hfits_import(interface,hfits,error)
    if (error) return
  end subroutine cubeio_header_put_tohfits
  !
  !---------------------------------------------------------------------
  !
  subroutine cubeio_hfits_export(hfits,out,error)
    !-------------------------------------------------------------------
    ! From type(fitsio_header_t) to type(cube_header_interface_t)
    !-------------------------------------------------------------------
    type(fitsio_header_t),         intent(in)    :: hfits
    type(cube_header_interface_t), intent(inout) :: out
    logical,                       intent(inout) :: error
    !
    character(len=*), parameter :: rname='HFITS>EXPORT'
    !
    call cubeio_message(ioseve%trace,rname,'Welcome')
    !
    ! Nullify everything first, leave them nullified if not relevant
    call out%init(error)
    if (error)  return
    !
    out%array_type = hfits%type
    out%axset_ndim = hfits%ndim
    out%axset_dim(1:hfits%ndim) = hfits%dim(1:hfits%ndim)
    !
    ! More general elements from the card dictionary
    call cubeio_hfits_export_spatial(hfits,out,error)
    if (error)  return
    call cubeio_hfits_export_convert(hfits,out,error)  ! After spatial
    if (error)  return
    call cubeio_hfits_export_array(hfits,out,error)
    if (error)  return
    call cubeio_hfits_export_spec(hfits,out,error)  ! After convert
    if (error)  return
    call cubeio_hfits_export_resolution(hfits,out,error)
    if (error)  return
    call cubeio_hfits_export_observatory(hfits,out,error)
    if (error)  return
  end subroutine cubeio_hfits_export
  !
  subroutine cubeio_hfits_export_convert(hfits,out,error)
    use gfits_types
    use cubetools_unit
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    type(fitsio_header_t),         intent(in)    :: hfits
    type(cube_header_interface_t), intent(inout) :: out
    logical,                       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HFITS>EXPORT>CONVERT'
    integer(kind=4) :: iaxis,minus
    character(len=6) :: key
    character(len=12) :: ctype,ccode,cunit,suffix,pname
    character(len=unit_l) :: axis_unit
    integer(kind=code_k) :: axis_kind
    logical :: found
    character(len=mess_l) :: mess
    real(kind=8) :: factor,crota(maxdim)
    !
    ! Defaults
    out%axset_name(:) = strg_unk
    out%axset_unit(:) = strg_unk
    out%axset_convert(code_ref,:) = 0.d0
    out%axset_convert(code_val,:) = 0.d0
    out%axset_convert(code_inc,:) = 1.d0
    crota(:) = 0.d0
    pname = ''
    out%axset_ix = 0
    out%axset_iy = 0
    out%axset_ic = 0
    !
    ! ZZZ Need spatial_frame_code before loop
    !
    do iaxis=1,out%axset_ndim
      !
      write(key,'(A5,I1)')  'CTYPE',iaxis
      call gfits_get_value(hfits%dict,key,found,ctype,error)
      if (error)  return
      if (.not.found) then
        write(mess,'(A,I0,3A)')  'File has ',out%axset_ndim,' dimensions but ',  &
          trim(key),' is not defined'
        call hfits%message(seve%w,rname,mess)
        cycle
      endif
      !
      minus = index(ctype,'-',back=.true.)
      if (minus.eq.0) then
        suffix = ' '
        ccode = ctype
      else
        suffix = ctype(minus+1:)
        minus = index(ctype,'-',back=.false.)
        ccode = ctype(1:minus-1)
      endif
      !
      cunit = strg_unk
      select case (ccode)
      case ('RA')
        if (out%spatial_frame_code.eq.code_spaframe_unknown) then
          ! RA is ambiguously used for EQUATORIAL or ICRS
          call hfits%message(seve%w,rname,'Coordinate system assumed EQUATORIAL')
          out%spatial_frame_code = code_spaframe_equatorial
        endif
        out%axset_ix = iaxis
        out%axset_name(iaxis) = 'RA'
        out%axset_kind(iaxis) = code_unit_fov
        cunit = 'deg'  ! Default if missing
        pname = suffix
      case ('DEC')
        if (out%spatial_frame_code.eq.code_spaframe_unknown) then
          ! DEC is ambiguously used for EQUATORIAL or ICRS
          call hfits%message(seve%w,rname,'Coordinate system assumed EQUATORIAL')
          out%spatial_frame_code = code_spaframe_equatorial
        endif
        out%axset_iy = iaxis
        out%axset_name(iaxis) = 'DEC'
        out%axset_kind(iaxis) = code_unit_fov
        cunit = 'deg'  ! Default if missing
        pname = suffix
      case ('LON','GLON')
        out%spatial_frame_code = code_spaframe_galactic
        out%axset_ix = iaxis
        out%axset_name(iaxis) = 'LII'
        out%axset_kind(iaxis) = code_unit_fov
        cunit = 'deg'  ! Default if missing
        pname = suffix
      case ('LAT','GLAT')
        out%spatial_frame_code = code_spaframe_galactic
        out%axset_iy = iaxis
        out%axset_name(iaxis) = 'BII'
        out%axset_kind(iaxis) = code_unit_fov
        cunit = 'deg'  ! Default if missing
        pname = suffix
      case ('VELOCITY','VELO','VRAD')
        out%axset_ic = iaxis
        out%axset_name(iaxis) = 'VELOCITY'
        out%axset_kind(iaxis) = code_unit_velo
        cunit = 'm/s'  ! Default if missing
      case ('FREQUENCY','FREQ')
        out%axset_ic = iaxis
        out%axset_name(iaxis) = 'FREQUENCY'
        out%axset_kind(iaxis) = code_unit_freq
        cunit = 'Hz'  ! Default if missing
      case ('LAMBDA')
        out%axset_ic = iaxis
        out%axset_name(iaxis) = 'LAMBDA'
        out%axset_kind(iaxis) = code_unit_unk
        ! cunit = ZZZ is there a default?
      case ('STOKES')
        out%axset_name(iaxis) = 'STOKES'
        out%axset_kind(iaxis) = code_unit_unk
      case default
        ! Non spatial or unsupported spatial axis
        ! Note that a projection can still be understood (axset_name split
        ! between ccode and suffix)
        ! ZZZ We might not want to split if projection is not understood
        out%axset_name(iaxis) = ccode
        out%axset_kind(iaxis) = code_unit_unk  ! Can not guess axis kind from name
                                             ! Will give a last try by looking at the unit (see below)
      end select
      !
      ! Unit and conversion factor to header_interface_t internal unit.
      write(key,'(A5,I1)')  'CUNIT',iaxis
      call gfits_get_value(hfits%dict,key,found,cunit,error)
      if (error)  return
      ! If not found, 'cunit' was not modified (which preserve preset default)
      if (cunit.ne.strg_unk) then
        ! Compute factor from FITS unit to header_interface_t internal unit.
        ! NB: this usually applies to known axes (e.g. RA-DEC-VELO, but unknown
        ! axes are converted too).
        call hfits_export_unit_factor(cunit,axis_unit,axis_kind,factor)
        out%axset_unit(iaxis) = axis_unit
        ! ZZZ Shouldn't we ensure that the unit found here is compatible with
        ! the kind resolved from axis name?
        ! out%axset_kind(iaxis) vs axis_kind
      else
        factor = 1.d0
        out%axset_unit(iaxis) = strg_unk
      endif
      !
      ! Kind? Last chance:
      if (out%axset_kind(iaxis).eq.code_unit_unk) then
        ! The axis kind could not be guessed from its name, apply guess from
        ! its unit
        out%axset_kind(iaxis) = axis_kind
      endif
      !
      ! Convert array
      write(key,'(A5,I1)')  'CRPIX',iaxis
      call gfits_get_value(hfits%dict,key,found,out%axset_convert(code_ref,iaxis),error)
      if (error)  return
      !
      write(key,'(A5,I1)')  'CRVAL',iaxis
      call gfits_get_value(hfits%dict,key,found,out%axset_convert(code_val,iaxis),error)
      if (error)  return
      out%axset_convert(code_val,iaxis) = out%axset_convert(code_val,iaxis)*factor
      !
      write(key,'(A5,I1)')  'CDELT',iaxis
      call gfits_get_value(hfits%dict,key,found,out%axset_convert(code_inc,iaxis),error)
      if (error)  return
      out%axset_convert(code_inc,iaxis) = out%axset_convert(code_inc,iaxis)*factor
      !
      write(key,'(A5,I1)')  'CROTA',iaxis
      call gfits_get_value(hfits%dict,key,found,crota(iaxis),error)
      if (error)  return
      crota(iaxis) = crota(iaxis)*factor  ! spatial_projection_pa also needs internal unit
      !
    enddo
    !
    call cubeio_hfits_export_cdmatrix(hfits,out,crota,error)
    if (error)  return
    !
    call cubeio_hfits_export_projection(hfits,pname,crota,out,error)
    if (error)  return
  end subroutine cubeio_hfits_export_convert
  !
  subroutine hfits_export_unit_factor(cunit,unit_name,unit_code,unit_factor)
    use phys_const
    use gkernel_interfaces
    use cubetools_unit_setup ! ***JP: I'd rather avoid using this one everywhere
    use cubetools_unit
    !-------------------------------------------------------------------
    ! Compute the conversion factor from FITS unit to header_interface_t
    ! internal unit. Note that there is no warranty the FITS unit names
    ! match the CUBE names: this function is specific to FITS.
    !-------------------------------------------------------------------
    character(len=*),     intent(in)  :: cunit
    character(len=*),     intent(out) :: unit_name  ! Resolved unit name
    integer(kind=code_k), intent(out) :: unit_code  ! Resolved unit code
    real(kind=8),         intent(out) :: unit_factor
    ! Local
    logical :: error
    type(unit_user_t) :: user
    !
    error = .false.
    call user%get_from_name(cunit,error)
    if (error)  return ! ZZZ
    !
    if (user%kind.eq.unit_unk) then
      ! Found nothing known
      unit_factor = 1.d0
      unit_name = cunit  ! Leave as is
    else
      ! Some supported unit
      unit_factor = user%prog_per_user   ! Scaling factor from this unit to 'interface' internal unit
      unit_name = user%kind%prog_name()  ! Translated to CUBE internal name
    endif
    unit_code = user%kind%code ! Known or unknown
  end subroutine hfits_export_unit_factor
  !
  subroutine cubeio_hfits_export_cdmatrix(hfits,out,crota,error)
    use phys_const
    use gfits_types
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    type(fitsio_header_t),         intent(in)    :: hfits
    type(cube_header_interface_t), intent(inout) :: out
    real(kind=8),                  intent(inout) :: crota(:)  ! [rad] Might be (re)defined here
    logical,                       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HFITS>EXPORT>CDMATRIX'
    real(kind=8) :: cd(2,2),pc(2,2),mat(2,2),factor
    integer(kind=4) :: numcd,numpc
    character(len=2) :: matname
    real(kind=4) :: ratio1,ratio2  ! R*4 to avoid useless digits
    character(len=unit_l) :: axis_unit
    integer(kind=code_k) :: axis_kind
    !
    ! Read CD and PC matrices (defaults as per Greisen & Calabretta paper I, section 2.1.2)
    cd(:,:) = 0.d0
    pc(1,1) = 1.d0
    pc(1,2) = 0.d0
    pc(2,1) = 0.d0
    pc(2,2) = 1.d0
    call read_matrix('CD',cd,numcd,error)
    if (error)  return
    call read_matrix('PC',pc,numpc,error)
    if (error)  return
    !
    if (numcd.gt.0 .and. numpc.gt.0) then
      ! Invalid as per the above named paper
      call hfits%message(seve%w,rname,'Invalid mixture of CD and PC matrix')
      error = .true.
      return
    elseif (numcd.gt.0) then
      if (numcd.ne.4)  &
        call hfits%message(seve%w,rname,'CD matrix is incomplete')
      matname = 'CD'
      mat = cd
      ! Compute factor assuming the increments in the CD matrix are expressed
      ! in degrees/pixel
      call hfits_export_unit_factor('deg',axis_unit,axis_kind,factor)
    elseif (numpc.gt.0) then
      if (numpc.ne.4)  &
        call hfits%message(seve%w,rname,'PC matrix is incomplete')
      matname = 'PC'
      mat = pc
      ! Convert PC matrix to a CD matrix (i.e. also convey the increments).
      ! See Calabretta & Greisen Paper II, Eq. 1. This is important to take
      ! into account the CDELTi sign to compute the right angle (atan2 below).
      mat(1,1) = mat(1,1)*out%axset_convert(code_inc,1)  ! [rad]
      mat(1,2) = mat(1,2)*out%axset_convert(code_inc,1)  ! [rad]
      mat(2,1) = mat(2,1)*out%axset_convert(code_inc,2)  ! [rad]
      mat(2,2) = mat(2,2)*out%axset_convert(code_inc,2)  ! [rad]
      factor = 1.d0  ! Already in internal unit (radians)
    else ! Both are null: nothing to do
      return
    endif
    !
    ratio1 = mat(1,1)/mat(2,2)
    ratio2 = sqrt(mat(1,1)**2+mat(2,1)**2) / sqrt(mat(1,2)**2+mat(2,2)**2)
    if ((abs(ratio1)-ratio2)/ratio2.gt.1e-4) then
      ! This is not a rotation, but a more complex matrix
      call hfits%message(seve%e,rname,matname//'i_j matrix is skewed')
      error = .true.
      return
    endif
    ! CD matrix encodes both the increments and the rotation angle
    out%axset_convert(code_inc,1) = sqrt(mat(1,1)**2+mat(2,1)**2)*factor
    out%axset_convert(code_inc,2) = sqrt(mat(1,2)**2+mat(2,2)**2)*factor
    if (ratio1.lt.0) then  ! i.e. mat(1,1) and mat(2,2) are opposite sign
      ! One axis has been inverted
      ! Assume this is the first one ...
      mat(1,1) = -mat(1,1)
      mat(2,1) = -mat(2,1)
      out%axset_convert(code_inc,1) = -out%axset_convert(code_inc,1)
    endif
    !
    ! Rotation ...
    crota(1) =  atan2(mat(2,1),mat(1,1))  ! [rad] header_interface_t internal unit
    crota(2) = -atan2(mat(1,2),mat(2,2))  ! [rad]
    !
    ! Verification de coherence: les CDELTi doivent etres a 1 ou 0, a faire...
    !
  contains
    subroutine read_matrix(name,mat,num,error)
      character(len=*), intent(in)    :: name
      real(kind=8),     intent(inout) :: mat(2,2)
      integer(kind=4),  intent(out)   :: num
      logical,          intent(inout) :: error
      !
      logical :: found
      !
      num = 0
      call gfits_get_value(hfits%dict,name//'1_1',found,mat(1,1),error)
      if (error)  return
      if (found)  num = num+1
      call gfits_get_value(hfits%dict,name//'1_2',found,mat(1,2),error)
      if (error)  return
      if (found)  num = num+1
      call gfits_get_value(hfits%dict,name//'2_1',found,mat(2,1),error)
      if (error)  return
      if (found)  num = num+1
      call gfits_get_value(hfits%dict,name//'2_2',found,mat(2,2),error)
      if (error)  return
      if (found)  num = num+1
    end subroutine read_matrix
  end subroutine cubeio_hfits_export_cdmatrix
  !
  subroutine cubeio_hfits_export_projection(hfits,pname,crota,out,error)
    use gbl_constant
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    type(fitsio_header_t),         intent(in)    :: hfits
    character(len=*),              intent(in)    :: pname
    real(kind=8),                  intent(in)    :: crota(:)
    type(cube_header_interface_t), intent(inout) :: out
    logical,                       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HFITS>EXPORT>PROJECTION'
    !
    ! Projection type
    select case (pname)
    case ('')
      ! Projection is not defined. Quoting Greisen & Calabretta 2002: "CTYPEi
      ! values that are not in "4–3" form should be interpreted as linear axes."
      call hfits%message(seve%w,rname,'Projection assumed CARTESIAN')
      out%spatial_projection_code = p_cartesian
    case ('TAN')
      out%spatial_projection_code = p_gnomonic
    case ('AIT','ATF')  !  Hammer-Aitoff (ATF code was formerly written by some GILDAS programs)
      out%spatial_projection_code = p_aitoff
    case ('SIN')
      ! Note that Gildas does not support extended SIN (Slant orthographic).
      ! See Calabretta & Greisen 2002, sections 5.1.5 and 6.1.1. We should
      ! reject the cases when PVi_j are defined and non-zero.
      out%spatial_projection_code = p_ortho  ! Orthographic or Dixon
    case ('ARC')
      out%spatial_projection_code = p_azimuthal  ! Schmidt or Azimuthal
    case ('STG')  ! Stereographic
      out%spatial_projection_code = p_stereo
    case ('GLS')
      out%spatial_projection_code = p_radio
    case ('CAR')  ! Cartesian
      out%spatial_projection_code = p_cartesian
    case ('SFL')
      out%spatial_projection_code = p_sfl
    case ('NCP')  ! North Celestial Pole
      ! Gildas offers native support. Note that according to Calabretta
      ! & Greisen 2002, NCP is obsolete and should be translated to
      ! (see section 6.1.2):
      !     SIN with PV2_1 = 0 and PV2_2 = 1/tan(d0)
      ! This defines an "extented" SIN projection (Slant orthographic, see
      ! section 5.1.5). However, Gildas supports only the (non-extended)
      ! orthographic projection with SIN with PV2_1 = PV2_2 = 0 (see section
      ! 6.1.1).
      out%spatial_projection_code = p_ncp
    case default
      call hfits%message(seve%w,rname,'Unrecognized projection '//pname)
      out%spatial_projection_code = p_none
    end select
    !
    ! Projection angle. Can be defined in CROTA2 but not CROTA1.
    if (out%axset_ix.ne.0 .and. crota(out%axset_ix).ne.0.d0) then
      out%spatial_projection_pa = crota(out%axset_ix)
    elseif (out%axset_iy.ne.0 .and. crota(out%axset_iy).ne.0.d0) then
      out%spatial_projection_pa = crota(out%axset_iy)
    else
      out%spatial_projection_pa = 0.d0
    endif
    !
    ! Projection center
    if (out%axset_ix.ne.0) then
      out%spatial_projection_l0 = out%axset_convert(code_val,out%axset_ix)
      out%axset_convert(code_val,out%axset_ix) = 0.d0
    endif
    if (out%axset_iy.ne.0) then
      out%spatial_projection_m0 = out%axset_convert(code_val,out%axset_iy)
      out%axset_convert(code_val,out%axset_iy) = 0.d0
    endif
  end subroutine cubeio_hfits_export_projection
  !
  subroutine cubeio_hfits_export_array(hfits,out,error)
    use gfits_types
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    type(fitsio_header_t),         intent(in)    :: hfits
    type(cube_header_interface_t), intent(inout) :: out
    logical,                       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HFITS>EXPORT>ARRAY'
    logical :: found
    character(len=12) :: tempscale
    !
    call gfits_get_value(hfits%dict,'DATAMIN',found,out%array_minval,error)
    if (error)  return
    !
    call gfits_get_value(hfits%dict,'DATAMAX',found,out%array_maxval,error)
    if (error)  return
    !
    call gfits_get_value(hfits%dict,'BUNIT',found,out%array_unit,error)
    if (error)  return
    !
    tempscale = ''
    call gfits_get_value(hfits%dict,'TEMPSCAL',found,tempscale,error)
    if (error)  return
    if (tempscale.ne.'') then
      ! Try to format to the usual Gildas encoding e.g. "K (TA*)"
      out%array_unit = trim(out%array_unit)//' ('//trim(tempscale)//')'
    endif
  end subroutine cubeio_hfits_export_array
  !
  subroutine cubeio_hfits_export_spatial(hfits,out,error)
    use gbl_constant
    use gfits_types
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    type(fitsio_header_t),         intent(in)    :: hfits
    type(cube_header_interface_t), intent(inout) :: out
    logical,                       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HFITS>EXPORT>SPAFRAME'
    integer(kind=4) :: ier
    logical :: found
    character(len=80) :: value
    !
    call gfits_get_value(hfits%dict,'OBJECT',found,out%spatial_source,error)
    if (error)  return
    !
    ! Default equinox (NB: FITS says RADESYS defaults to FK5 if absent, i.e.
    ! there is a valid default system and equinox...)
    out%spatial_frame_code = code_spaframe_unknown
    out%spatial_frame_equinox = equinox_null
    !
    ! System and optionally equinox
    call gfits_get_value(hfits%dict,'RADESYS',found,value,error)
    if (error)  return
    if (.not.found) then  ! Try deprecated RADECSYS
      call gfits_get_value(hfits%dict,'RADECSYS',found,value,error)
      if (error)  return
    endif
    if (found) then
      ! From RADESYS
      if (value(1:8).eq.'FK4-NO-E') then
        out%spatial_frame_code = code_spaframe_equatorial
        out%spatial_frame_equinox = 1950.0
      elseif (value(1:3).eq.'FK4') then
        out%spatial_frame_code = code_spaframe_equatorial
        out%spatial_frame_equinox = 1950.0
      elseif (value(1:3).eq.'FK5') then
        out%spatial_frame_code = code_spaframe_equatorial
        out%spatial_frame_equinox = 2000.0
      elseif (value(1:4).eq.'ICRS') then
        out%spatial_frame_code = code_spaframe_icrs
        out%spatial_frame_equinox = equinox_null  ! Irrelevant for ICRS
      endif
    endif
    !
    ! EQUINOX (or EPOCH)
    call gfits_get_value(hfits%dict,'EQUINOX',found,value,error)
    if (error)  return
    if (.not.found) then
      call gfits_get_value(hfits%dict,'EPOCH',found,value,error)
      if (error)  return
    endif
    if (found) then
      read(value,*,iostat=ier) out%spatial_frame_equinox
      if (ier.ne.0) then
        if (value(1:1).eq.'J') then
          read(value(2:),*,iostat=ier) out%spatial_frame_equinox
        elseif (value(1:1).eq.'B') then
          read(value(2:),*,iostat=ier) out%spatial_frame_equinox
        endif
        if (ier.ne.0) then
          call hfits%message(seve%e,rname,'Undecipherable Equinox '//value)
          out%spatial_frame_equinox = equinox_null
        endif
      endif
    endif
  end subroutine cubeio_hfits_export_spatial
  !
  subroutine cubeio_hfits_export_spec(hfits,out,error)
    use phys_const
    use gfits_types
    use cubetools_convert
    use cubetools_unit
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    type(fitsio_header_t),         intent(in)    :: hfits
    type(cube_header_interface_t), intent(inout) :: out
    logical,                       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HFITS>EXPORT>SPEC'
    integer(kind=4) :: velref
    logical :: found
    character(len=12) :: specsys
    real(kind=8) :: vres,altrpix
    character(len=8) :: veloname
    !
    ! Velocity type
    out%spectral_convention = code_speconv_radio  ! Default if missing
    out%spectral_frame_code = code_speframe_lsrk  ! Default if missing
    call gfits_get_value(hfits%dict,'SPECSYS',found,specsys,error)
    if (error)  return
    if (found) then
      select case (specsys)
      case ('LSRK')
        out%spectral_frame_code = code_speframe_lsrk
      case ('HEL','BARYCENT')
        out%spectral_frame_code = code_speframe_helio
      case ('TOPOCENT')
        out%spectral_frame_code = code_speframe_obser
      case default
        call hfits%message(seve%w,rname,'SPECSYS '//trim(specsys)//  &
          ' not understood, spectral frame assumed LSRk')
      end select
    else
      call gfits_get_value(hfits%dict,'VELREF',found,velref,error)
      if (error)  return
      if (found) then
        if (velref.gt.velref_convention_radio) then
          out%spectral_convention = code_speconv_radio
          velref = velref-velref_convention_radio
        else
          out%spectral_convention = code_speconv_optical
          velref = velref-velref_convention_optical
        endif
        select case (velref)
        case (velref_frame_lsrk)
          out%spectral_frame_code = code_speframe_lsrk
        case (velref_frame_helio)
          out%spectral_frame_code = code_speframe_helio
        case (velref_frame_obs)
          out%spectral_frame_code = code_speframe_obser
        case default
          call hfits%message(seve%w,rname,  &
            'Invalid VELREF, assuming radio convention and spectral frame LSRk')
          out%spectral_convention = code_speconv_radio
          out%spectral_frame_code = code_speframe_lsrk
        end select
      else
        call hfits%message(seve%w,rname,  &
          'SPECSYS and VELREF missing, assuming radio convention and spectral frame LSRk')
      endif
    endif
    !
    ! LINE
    call gfits_get_value(hfits%dict,'LINE',found,out%spectral_line,error)
    if (error)  return
    if (.not.found) then
      call gfits_get_value(hfits%dict,'LINENAME',found,out%spectral_line,error)
      if (error)  return
    endif
    if (.not.found) then
      out%spectral_line = strg_unk
    endif
    !
    out%spectral_code = code_spectral_unknown  ! Default before looking for specific keywords
    !
    ! Velocity offset
    select case (out%spectral_frame_code)
    case (code_speframe_lsrk)
      veloname = 'VELO-LSR'
    case (code_speframe_helio)
      veloname = 'VELO-HEL'
    case (code_speframe_obser)
      veloname = 'VELO-OBS'
    case default
      veloname = 'VELOCITY'
    end select
    out%spectral_systemic_code = code_systemic_velocity
    call gfits_get_value(hfits%dict,veloname,found,out%spectral_systemic_value,error)
    if (error)  return
    if (found) then
      out%spectral_code = code_spectral_frequency
      ! Up to now VELO-LSR has no known unit => assume m/s, convert to km/s
      out%spectral_systemic_value = out%spectral_systemic_value*1e-3
    elseif (out%axset_ic.gt.0 .and. out%axset_name(out%axset_ic).eq.'VELOCITY') then
      out%spectral_code = code_spectral_frequency
      out%spectral_systemic_value = out%axset_convert(code_val,out%axset_ic)  ! Already in 'interface' internal unit
    else
      ! No velocity axis nor velocity offset...
      call hfits%message(seve%w,rname,'Missing velocity description')
      out%spectral_systemic_value = 0.d0
    endif
    !
    ! Rest frequency: CUBE assumes it is aligned with reference channel / CRVALi.
    ! Several possibilities, in order:
    !  1) from CRVALi if defined and if axis is FREQUENCY. This gives proper
    !     description of the velocity axis, but looses the informative RESTFRQ;
    !  2) from the RESTFREQ or RESTFRQ keyword if axis is VELOCITY;
    !  3) from ALTRVAL if axis is VELOCITY.
    found = .false.
    if (out%axset_ic.gt.0 .and.  &
        out%axset_name(out%axset_ic).eq.'FREQUENCY' .and.  &
        out%axset_convert(code_val,out%axset_ic).gt.0.d0) then
       out%spectral_signal_value = out%axset_convert(code_val,out%axset_ic)*1d6
       found = .true.
    endif
    if (.not.found) then
      call gfits_get_value(hfits%dict,'RESTFREQ',found,out%spectral_signal_value,error)
      if (error)  return
    endif
    if (.not.found) then
      call gfits_get_value(hfits%dict,'RESTFRQ',found,out%spectral_signal_value,error)
      if (error)  return
    endif
    if (.not.found .and. out%axset_ic.gt.0 .and.  &
        out%axset_name(out%axset_ic).eq.'VELOCITY') then
      ! Rest frequency not yet found, try to derive from ALTRVAL/ALTRPIX.
      ! Note: if RESTFREQ is already known (usual case), we should check the
      ! consistency between RESTFREQ, convert[*,faxi], and ALTRVAL/ALTRPIX
      call hfits%message(seve%w,rname,'Deriving rest frequency from ALTRVAL/ALTRPIX')
      call gfits_get_value(hfits%dict,'ALTRVAL',found,out%spectral_signal_value,error)
      if (error)  return
      call gfits_get_value(hfits%dict,'ALTRPIX',found,altrpix,error)
      if (error)  return
      if (found) then
        ! Frequency at ref. channel (in case it is different from ALTRPIX)
        out%spectral_signal_value = out%spectral_signal_value -  &
          (altrpix-out%axset_convert(code_ref,out%axset_ic)) *  &
          out%axset_convert(code_inc,out%axset_ic) * out%spectral_signal_value / clight_kms
        ! Rest frequency corresponds to velocity = 0 (LSR frame)
        out%spectral_signal_value = out%spectral_signal_value -  &
          out%axset_convert(code_val,out%axset_ic) *  &
          out%axset_convert(code_inc,out%axset_ic) * out%spectral_signal_value / clight_kms
      endif
    endif
    if (found) then
      out%spectral_code = code_spectral_frequency
      ! Up to now RESTFREQ has no known unit => assume Hz, convert to MHz
      out%spectral_signal_value = out%spectral_signal_value*1d-6
    endif
    !
    ! Value at reference channel
    if (out%axset_ic.gt.0 .and.  &
        out%axset_name(out%axset_ic).eq.'FREQUENCY' .and.  &
        out%axset_convert(code_val,out%axset_ic).le.0.d0) then
      ! Clearly undefined for this frequency axis (would not be so clear if it was
      ! a velocity axis). Take from rest frequency, if we found it:
      if (out%spectral_signal_value.gt.0.d0) then
        out%axset_convert(code_val,out%axset_ic) = out%spectral_signal_value  ! [MHz]
      endif
    endif
    !
    ! Image frequency
    call gfits_get_value(hfits%dict,'IMAGFREQ',found,out%spectral_image_value,error)
    if (error)  return
    out%spectral_image_value = out%spectral_image_value*1d-6  ! Assume Hz, convert to MHz
    !
    out%spectral_increment_value = 0.d0
    if (out%axset_ic.ne.0) then
      if (out%axset_name(out%axset_ic).eq.'VELOCITY') then
        vres = out%axset_convert(code_inc,out%axset_ic)
        out%spectral_increment_value = cubetools_convert_vres2fres(vres,out%spectral_signal_value)
      elseif (out%axset_name(out%axset_ic).eq.'FREQUENCY') then
        out%spectral_increment_value = out%axset_convert(code_inc,out%axset_ic)
      endif
    endif
  end subroutine cubeio_hfits_export_spec
  !
  subroutine cubeio_hfits_export_resolution(hfits,out,error)
    use phys_const
    use gfits_types
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    type(fitsio_header_t),         intent(in)    :: hfits
    type(cube_header_interface_t), intent(inout) :: out
    logical,                       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HFITS>EXPORT>RESOLUTION'
    logical :: found
    !
    out%spatial_beam_major = 0.
    call gfits_get_value(hfits%dict,'BMAJ',found,out%spatial_beam_major,error)
    if (error)  return
    if (found)  out%spatial_beam_major = out%spatial_beam_major*rad_per_deg
    !
    out%spatial_beam_minor = 0.
    call gfits_get_value(hfits%dict,'BMIN',found,out%spatial_beam_minor,error)
    if (error)  return
    if (found)  out%spatial_beam_minor = out%spatial_beam_minor*rad_per_deg
    !
    out%spatial_beam_pa = 0.
    call gfits_get_value(hfits%dict,'BPA', found,out%spatial_beam_pa,error)
    if (error)  return
    if (found)  out%spatial_beam_pa = out%spatial_beam_pa*rad_per_deg
  end subroutine cubeio_hfits_export_resolution
  !
  subroutine cubeio_hfits_export_observatory(hfits,out,error)
    use phys_const
    use gfits_types
    use cubetools_string
    use cubetools_observatory_types
    use cubetools_obstel_types
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    type(fitsio_header_t),         intent(in)    :: hfits
    type(cube_header_interface_t), intent(inout) :: out
    logical,                       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HFITS>EXPORT>OBSERVATORY'
    logical :: found
    character(len=24) :: telescope
    character(len=12), allocatable :: alltel(:)
    real(kind=8) :: lonlat(2),altitude,slimit
    real(kind=4) :: diam,altitude4
    integer(kind=4) :: itel
    !
    call gfits_get_value(hfits%dict,'TELESCOP',found,telescope,error)
    if (error)  return
    if (found) then
      call cubetools_string_split(telescope,telescop_separator,alltel,error)
      if (error)  return
      call cubetools_observatory_reallocate(size(alltel),out%obs,error)
      if (error) return
      ! Split telescopes
      out%obs%ntel = 0
      do itel=1,size(alltel)
        call gwcs_observatory(alltel(itel),lonlat,altitude,slimit,diam,error)
        if (error) then
          ! Observatory not recognized is not an error
          error = .false.
          cycle
        endif
        out%obs%ntel = out%obs%ntel+1
        altitude4 = altitude*1e3  ! Convert from km to m
        call cubetools_obstel_get_and_derive(lonlat(1)*rad_per_deg,  &
          lonlat(2)*rad_per_deg,altitude4,diam,alltel(itel),  &
          out%obs%tel(out%obs%ntel),error)
        if (error)  return
      enddo
      if (out%obs%ntel.gt.0) return
    endif
    !
    call cubetools_observatory_final(out%obs,error)
    if (error)  return
  end subroutine cubeio_hfits_export_observatory
  !
  !---------------------------------------------------------------------
  !
  subroutine cubeio_hfits_import(in,hfits,error)
    use phys_const
    use cubetools_string
    use cubefitsio_header_write
    !-------------------------------------------------------------------
    ! From type(cube_header_interface_t) to type(fitsio_header_t)
    !-------------------------------------------------------------------
    type(cube_header_interface_t), intent(in)    :: in
    type(fitsio_header_t),         intent(inout) :: hfits
    logical,                       intent(inout) :: error
    !
    integer(kind=ndim_k) :: ndim,iaxis
    real(kind=8) :: altrval,altrpix
    integer(kind=4) :: velrefcode
    character(len=12) :: specsyscode,altunit
    character(len=23) :: date,teles
    character(len=*), parameter :: rname='HFITS>IMPORT'
    !
    call cubeio_message(ioseve%trace,rname,'Welcome')
    !
    ! Data format
    hfits%type = in%array_type
    ! Dimension section
    if (in%axset_ndim.le.maxdim) then
       ndim = in%axset_ndim
    else
       call hfits%message(seve%d,rname,'Larger number of dimensions than room to store it! => Truncating')
       ndim = maxdim
    endif
    hfits%ndim = ndim
    hfits%dim = 0
    hfits%dim(1:ndim) = in%axset_dim(1:ndim)
    !
    ! Other components
    hfits%dict%ncard = 0
    !
    ! Data
    call cubefitsio_header_addr4(hfits,'DATAMIN',in%array_minval,'',error)
    if (error)  return
    call cubefitsio_header_addr4(hfits,'DATAMAX',in%array_maxval,'',error)
    if (error)  return
    if (in%array_unit.eq.'') then
      call cubefitsio_header_addstr(hfits,'BUNIT','UNKNOWN','',error)
      if (error)  return
    else
      call cubefitsio_header_addstr(hfits,'BUNIT',in%array_unit,'',error)
      if (error)  return
    endif
    !
    ! Axes
    do iaxis=1,ndim
      call cubeio_hfits_import_axis(in,iaxis,hfits,error)
      if (error)  return
    enddo
    !
    ! Rotation matrix
    call cubeio_hfits_import_pcmatrix(in,hfits,error)
    if (error)  return
    !
    ! Position section
    call cubefitsio_header_addstr(hfits,'OBJECT',in%spatial_source,'',error)
    if (error)  return
    select case (in%spatial_frame_code)
    case (code_spaframe_icrs)
      call cubefitsio_header_addstr(hfits,'RADESYS','ICRS','Coordinate system',error)
      if (error)  return
      call cubefitsio_header_addr8(hfits,'RA',in%spatial_projection_l0*deg_per_rad,'[deg] Right ascension',error)
      if (error)  return
      call cubefitsio_header_addr8(hfits,'DEC',in%spatial_projection_m0*deg_per_rad,'[deg] Declination',error)
      if (error)  return
    case (code_spaframe_equatorial)
      if (nearly_equal(in%spatial_frame_equinox,2000.,1e-6)) then
        call cubefitsio_header_addstr(hfits,'RADESYS','FK5','Coordinate system',error)
        if (error)  return
      endif
      call cubefitsio_header_addr8(hfits,'RA',in%spatial_projection_l0*deg_per_rad,'[deg] Right ascension',error)
      if (error)  return
      call cubefitsio_header_addr8(hfits,'DEC',in%spatial_projection_m0*deg_per_rad,'[deg] Declination',error)
      if (error)  return
      call cubefitsio_header_addr4(hfits,'EQUINOX',in%spatial_frame_equinox,'',error)
      if (error)  return
    case (code_spaframe_galactic)
      call cubefitsio_header_addr8(hfits,'GLAT',in%spatial_projection_l0*deg_per_rad,'[deg] Galactic latitude',error)
      if (error)  return
      call cubefitsio_header_addr8(hfits,'GLON',in%spatial_projection_m0*deg_per_rad,'[deg] Galactic longitude',error)
      if (error)  return
    case default
      call cubefitsio_header_addcomment(hfits,'Unknown coordinate system',error)
      if (error)  return
    end select
    !
    ! Spectroscopic axis
    if (in%axset_ic.gt.0) then
      ! Spectroscopic axis is defined => try to declare ALTRPIX/ALTRVAL
      if (in%axset_name(in%axset_ic).eq.'FREQUENCY' .or.  &
          in%axset_name(in%axset_ic).eq.'VELOCITY') then
        altrpix = in%axset_convert(1,in%axset_ic)
        call cubefitsio_header_addr8(hfits,'ALTRPIX',altrpix,'',error)
        if (error)  return
        if (in%axset_name(in%axset_ic).eq.'FREQUENCY') then
          altrval = in%axset_convert(2,in%axset_ic)                 ! [MHz] Freq. at ref. pixel
          altrval = clight*(1.d0-altrval/in%spectral_signal_value)  ! [m/s] Velocity = c*(1-z)
          altunit = '[m/s]'
        else
          altrval = in%axset_convert(2,in%axset_ic)                     ! [km/s] Velocity at ref. pixel
          altrval = in%spectral_signal_value*(1.d0-altrval/clight_kms)  ! [MHz]
          altrval = altrval * 1d6                                       ! [Hz]
          altunit = '[Hz]'
        endif
        call cubefitsio_header_addr8(hfits,'ALTRVAL',altrval,altunit,error)
        if (error)  return
      endif
    endif
    ! Other components: export them "as is", should the spectroscopic axis
    ! be defined or not
    call cubefitsio_header_addstr(hfits,'LINE',in%spectral_line,'',error)
    if (error)  return
    call cubefitsio_header_addr8(hfits,'RESTFREQ',in%spectral_signal_value*1d6,'[Hz]',error)
    if (error)  return
    call cubefitsio_header_addr8(hfits,'IMAGFREQ',in%spectral_image_value*1d6,'[Hz]',error)
    if (error)  return
    select case (in%spectral_convention)
    case (code_speconv_radio)
      velrefcode = velref_convention_radio
    case (code_speconv_optical)
      velrefcode = velref_convention_optical
    case default
      call hfits%message(seve%w,rname,'Spectral convention not supported in FITS, assuming radio')
      velrefcode = velref_convention_radio
    end select
    select case (in%spectral_frame_code)
    case (code_speframe_lsrk)
      call cubefitsio_header_addr8(hfits,'VELO-LSR',in%spectral_systemic_value*1d3,'[m/s]',error)
      if (error)  return
      velrefcode = velrefcode+velref_frame_lsrk
      specsyscode = 'LSRK'
    case (code_speframe_helio)
      call cubefitsio_header_addr8(hfits,'VELO-HEL',in%spectral_systemic_value*1d3,'[m/s]',error)
      if (error)  return
      velrefcode = velrefcode+velref_frame_helio
      specsyscode = 'BARYCENT'
    case (code_speframe_obser)
      call cubefitsio_header_addr8(hfits,'VELO-OBS',in%spectral_systemic_value*1d3,'[m/s]',error)
      if (error)  return
      velrefcode = velrefcode+velref_frame_obs
      specsyscode = 'TOPOCENT'
    case default
      call cubefitsio_header_addr8(hfits,'VELOCITY',in%spectral_systemic_value*1d3,'[m/s]',error)
      if (error)  return
      velrefcode = 0
      specsyscode = ' '
    end select
    call cubefitsio_header_addi4(hfits,'VELREF',velrefcode,'',error)
    if (error)  return
    call cubefitsio_header_addstr(hfits,'SPECSYS',specsyscode,'',error)
    if (error)  return
    !
    ! Spatial resolution
    if (in%spatial_beam_major.gt.0.0) then
      call cubefitsio_header_addr8(hfits,'BMAJ',in%spatial_beam_major*deg_per_rad,'[deg]',error)
      if (error)  return
      call cubefitsio_header_addr8(hfits,'BMIN',in%spatial_beam_minor*deg_per_rad,'[deg]',error)
      if (error)  return
      call cubefitsio_header_addr8(hfits,'BPA',in%spatial_beam_pa*deg_per_rad,'[deg]',error)
      if (error)  return
    endif
    !
    ! Observatory
    if (in%obs%ntel.gt.0) then
      call cubetools_string_concat(in%obs%ntel,in%obs%tel(1:in%obs%ntel)%name,  &
        telescop_separator,teles,error)
      if (error)  return
      call cubefitsio_header_addstr(hfits,'TELESCOP',teles,'',error)
      if (error)  return
    endif
    !
    ! Misc
    call cubefitsio_header_addstr(hfits,'ORIGIN','GILDAS CUBE','',error)
    if (error)  return
    call sic_isodate(date)
    call cubefitsio_header_addstr(hfits,'DATE',date,'Date written',error)
    if (error)  return
  end subroutine cubeio_hfits_import
  !
  subroutine cubeio_hfits_import_axis(in,iaxis,hfits,error)
    use gbl_constant
    use phys_const
    use cubefitsio_header_write
    !-------------------------------------------------------------------
    ! Import one of the axes
    !-------------------------------------------------------------------
    type(cube_header_interface_t), intent(in)    :: in
    integer(kind=ndim_k),          intent(in)    :: iaxis
    type(fitsio_header_t),         intent(inout) :: hfits
    logical,                       intent(inout) :: error
    !
    character(len=*), parameter :: rname='HFITS>IMPORT>AXIS'
    character(len=6) :: ctype,crval,cdelt,crpix,cunit
    real(kind=8) :: val,inc,ref
    character(len=12) :: code
    logical :: projected
    integer(kind=4) :: l
    character(len=6) :: axisunit
    !
    write(ctype,'(A,I1)')  'CTYPE',iaxis
    write(crval,'(A,I1)')  'CRVAL',iaxis
    write(cdelt,'(A,I1)')  'CDELT',iaxis
    write(crpix,'(A,I1)')  'CRPIX',iaxis
    write(cunit,'(A,I1)')  'CUNIT',iaxis
    !
    if (in%spatial_projection_code.eq.code_unk .or.  &
        in%spatial_projection_code.eq.p_none) then
      projected = .false.
    else
      projected = iaxis.eq.in%axset_ix .or. iaxis.eq.in%axset_iy
    endif
    !
    ref = in%axset_convert(1,iaxis)
    val = in%axset_convert(2,iaxis)
    inc = in%axset_convert(3,iaxis)
    code = in%axset_name(iaxis)
    call sic_upper(code)  ! Case insensitive from cube_header_interface_t
    !
    if (code.eq.'L'.or.code.eq.'LII') then
      code = 'GLON'
    elseif (code.eq.'B'.or.code.eq.'BII') then
      code = 'GLAT'
    endif
    !
    if (projected) then
      ! Form is 4-3 e.g. XXXX-YYY
      l = len_trim(code)+1
      code(l:4) = '----'  ! Insert trailing - in the 4 part
      code(5:5) = '-'     ! Insert the - at the 5th position
      select case (in%spatial_projection_code)
      case (p_gnomonic)
        code(6:) = 'TAN'
      case (p_ortho)
        code(6:) = 'SIN'
      case (p_azimuthal)
        code(6:) = 'ARC'
      case (p_stereo)
        code(6:) = 'STG'
      case (p_aitoff)
        code(6:) = 'AIT'
      case (p_radio)
        code(6:) = 'GLS'
      case default
        code(6:) = '   '
      end select
      !
      ! Compute reference pixel so that VAL(REF) = 0
      ref = ref - val/inc
      if (iaxis.eq.in%axset_ix) then
        val = in%spatial_projection_l0
      else
        val = in%spatial_projection_m0
      endif
      val = val*deg_per_rad
      inc = inc*deg_per_rad
      axisunit = 'deg'
    elseif (code.eq.'RA'   .or. code.eq.'L'    .or. code.eq.'DEC' .or.  &
            code.eq.'B'    .or. code.eq.'LII'  .or. code.eq.'BII' .or.  &
            code.eq.'GLAT' .or. code.eq.'GLON' .or. code.eq.'LAT' .or.  &
            code.eq.'LON') then
      val = val*deg_per_rad
      inc = inc*deg_per_rad
      axisunit = 'deg'
    elseif (code.eq.'FREQUENCY') then
      code = 'FREQ'
      val = val*1.0d6            ! MHz to Hz
      inc = inc*1.0d6
      axisunit = 'Hz'
    elseif (code.eq.'VELOCITY') then
      code = 'VRAD'              ! force VRAD instead of VELOCITY for CASA
      val = val*1.0d3            ! km/s to m/s
      inc = inc*1.0d3
      axisunit = 'm/s'
    else
      l = len_trim(code)+1
      code(l:12) = '            '    ! fills with blanks code.
      axisunit = ''
    endif
    !
    call cubefitsio_header_addstr(hfits,ctype,code,'',error)
    if (error)  return
    call cubefitsio_header_addr8(hfits,crval,val,'',error)
    if (error)  return
    call cubefitsio_header_addr8(hfits,cdelt,inc,'',error)
    if (error)  return
    call cubefitsio_header_addr8(hfits,crpix,ref,'',error)
    if (error)  return
    call cubefitsio_header_addstr(hfits,cunit,axisunit,'',error)
    if (error)  return
  end subroutine cubeio_hfits_import_axis
  !
  subroutine cubeio_hfits_import_pcmatrix(in,hfits,error)
    use cubefitsio_header_write
    !-------------------------------------------------------------------
    ! Write the PC matrix describing the rotation, if any
    !-------------------------------------------------------------------
    type(cube_header_interface_t), intent(in)    :: in
    type(fitsio_header_t),         intent(inout) :: hfits
    logical,                       intent(inout) :: error
    !
    real(kind=8) :: cospa,sinpa,mat(2,2)
    integer(kind=1) :: ix,iy
    character(len=5) :: key
    character(len=*), parameter :: rname='HFITS>IMPORT>AXIS'
    !
    ! Do not write the matrix if no rotation
    if (in%spatial_projection_pa.eq.0.d0)  return
    !
    ix = in%axset_ix
    iy = in%axset_iy
    if (ix.eq.0 .or. iy.eq.0) then
      call cubeio_message(seve%w,rname,  &
        'X and/or Y spatial axes are not defined: can not export non-zero rotation angle')
      return
    endif
    !
    cospa = cos(in%spatial_projection_pa)
    sinpa = sin(in%spatial_projection_pa)
    !
    ! See e.g. https://fits.gsfc.nasa.gov/users_guide/users_guide/node57.html
    mat(1,1) =  cospa
    mat(1,2) = -sinpa * in%axset_convert(code_inc,iy)/in%axset_convert(code_inc,ix)
    mat(2,1) =  sinpa * in%axset_convert(code_inc,ix)/in%axset_convert(code_inc,iy)
    mat(2,2) =  cospa
    !
    write(key,10) ix,ix
    call cubefitsio_header_addr8(hfits,key,mat(1,1),'',error)
    if (error)  return
    write(key,10) ix,iy
    call cubefitsio_header_addr8(hfits,key,mat(1,2),'',error)
    if (error)  return
    write(key,10) iy,ix
    call cubefitsio_header_addr8(hfits,key,mat(2,1),'',error)
    if (error)  return
    write(key,10) iy,iy
    call cubefitsio_header_addr8(hfits,key,mat(2,2),'',error)
    if (error)  return
  10 format('PC',I1,'_',I1)
  end subroutine cubeio_hfits_import_pcmatrix
end module cubeio_header_hfits
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
