!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeio_header_hfits
  use cubetools_header_types
  use cubetools_header_interface
  use cubefitsio_header
  use cubeio_interface
  use cubeio_messaging
  !
  ! *** JP: These ones are (should) probably be defined elsewhere
  integer(kind=4), parameter :: iref=1,ival=2,iinc=3
  !
  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'
    real(kind=8) :: crota(maxdim)
    !
    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_convert(hfits,out,crota,error)
    if (error)  return
    call cubeio_hfits_export_array(hfits,out,error)
    if (error)  return
    call cubeio_hfits_export_system(hfits,crota,out,error)
    if (error)  return
    call cubeio_hfits_export_spec(hfits,out,error)
    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,crota,error)
    use gfits_types
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    type(fitsio_header_t),         intent(in)    :: hfits
    type(cube_header_interface_t), intent(inout) :: out
    real(kind=8),                  intent(out)   :: crota(:)
    logical,                       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HFITS>EXPORT>CONVERT'
    integer(kind=4) :: iaxis
    character(len=6) :: key
    logical :: found
    !
    ! Defaults
    out%axset_convert(iref,:) = 0.d0
    out%axset_convert(ival,:) = 0.d0
    out%axset_convert(iinc,:) = 1.d0
    crota(:) = 0.d0
    !
    do iaxis=1,maxdim
      write(key,'(A5,I1)')  'CRPIX',iaxis
      call gfits_get_value(hfits%dict,key,found,out%axset_convert(iref,iaxis),error)
      if (error)  return
      !
      write(key,'(A5,I1)')  'CRVAL',iaxis
      call gfits_get_value(hfits%dict,key,found,out%axset_convert(ival,iaxis),error)
      if (error)  return
      !
      write(key,'(A5,I1)')  'CDELT',iaxis
      call gfits_get_value(hfits%dict,key,found,out%axset_convert(iinc,iaxis),error)
      if (error)  return
      !
      write(key,'(A5,I1)')  'CROTA',iaxis
      call gfits_get_value(hfits%dict,key,found,crota(iaxis),error)
      if (error)  return
    enddo
    !
    call cubeio_hfits_export_cdmatrix(hfits,out,crota,error)
    if (error)  return
  end subroutine cubeio_hfits_export_convert
  !
  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(:)  ! Might be (re)defined here
    logical,                       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='HFITS>EXPORT>CDMATRIX'
    real(kind=8) :: cd(2,2)
    integer(kind=4) :: num
    real(kind=4) :: angle1,angle2,ratio1,ratio2  ! R*4 to avoid useless digits
    logical :: found
    !
    num = 0
    cd(:,:) = 0.d0
    !
    call gfits_get_value(hfits%dict,'CD1_1',found,cd(1,1),error)
    if (error)  return
    if (found)  num = num+1
    !
    call gfits_get_value(hfits%dict,'CD1_2',found,cd(1,2),error)
    if (error)  return
    if (found)  num = num+1
    !
    call gfits_get_value(hfits%dict,'CD2_1',found,cd(2,1),error)
    if (error)  return
    if (found)  num = num+1
    !
    call gfits_get_value(hfits%dict,'CD2_2',found,cd(2,2),error)
    if (error)  return
    if (found)  num = num+1
    !
    if (num.eq.0) then
      return
    elseif (num.eq.4) then
      call hfits%message(seve%w,rname,'Using CD Matrix')
    else
      call hfits%message(seve%w,rname,'CD Matrix is incomplete')
    endif
    !
    ratio1 = cd(1,1)/cd(2,2)
    ratio2 = sqrt(cd(1,1)**2+cd(2,1)**2) / sqrt(cd(1,2)**2+cd(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,'CDi_j matrix is skewed')
      error = .true.
      return
    endif
    out%axset_convert(iinc,1) = sqrt(cd(1,1)**2+cd(2,1)**2)
    out%axset_convert(iinc,2) = sqrt(cd(1,2)**2+cd(2,2)**2)
    if (ratio1/ratio2.lt.0) then
      ! One axis has been inverted
      ! Assume this is the first one ...
      cd(1,1) = -cd(1,1)
      cd(2,1) = -cd(2,1)
      out%axset_convert(iinc,1) = -out%axset_convert(3,1)
    endif
    !
    ! Rotation ...
    angle1 = atan2(cd(2,1),cd(1,1))
    angle2 = -atan2(cd(1,2),cd(2,2))
    crota(1) = angle1*deg_per_rad
    crota(2) = angle2*deg_per_rad  ! Must be in degree
    !
    ! Verification de coherence: les CDELTi doivent etres a 1 ou 0, a faire...
    !
  end subroutine cubeio_hfits_export_cdmatrix
  !
  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_system(hfits,crota,out,error)
    use phys_const
    use gbl_constant
    use gfits_types
    use cubetools_unit
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    type(fitsio_header_t),         intent(in)    :: hfits
    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>SYSTEM'
    integer(kind=4) :: iaxis,minus,ier
    character(len=6) :: key
    logical :: found
    character(len=12) :: rccode,suffix,pname
    character(len=80) :: value
    character(len=message_length) :: mess
    !
    call gfits_get_value(hfits%dict,'OBJECT',found,out%spatial_source,error)
    if (error)  return
    !
    ! Default equinox (NB: FITS says RADESYS defaults to FK5 is 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
    !
    pname = ''
    out%axset_ix = 0
    out%axset_iy = 0
    do iaxis=1,out%axset_ndim
      !
      write(key,'(A5,I1)')  'CTYPE',iaxis
      call gfits_get_value(hfits%dict,key,found,rccode,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
      !
      ! Split system and projection
      minus = index(rccode,'-',back=.true.)
      if (minus.eq.0) then
        suffix = ' '
      else
        suffix = rccode(minus+1:)
        minus = index(rccode,'-',back=.false.)
        rccode = rccode(:minus-1)
      endif
      !
      ! System
      select case (rccode)
      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
        out%spatial_projection_l0 = out%axset_convert(ival,iaxis)*rad_per_deg
        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
        out%spatial_projection_m0 = out%axset_convert(ival,iaxis)*rad_per_deg
        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
        out%spatial_projection_l0 = out%axset_convert(ival,iaxis)*rad_per_deg
        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
        out%spatial_projection_m0 = out%axset_convert(ival,iaxis)*rad_per_deg
        pname = suffix
      case default
        out%axset_name(iaxis) = rccode
        cycle  ! Non spatial dimension => cycle to next one
      end select
      !
      ! Factorized for all of the 4 spatial cases:
      out%axset_convert(ival,iaxis) = 0.d0
      out%axset_convert(iinc,iaxis) = out%axset_convert(iinc,iaxis)*rad_per_deg
    enddo
    !
    ! 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)*rad_per_deg  ! From deg to internal rad
    elseif (out%axset_iy.ne.0 .and. crota(out%axset_iy).ne.0.d0) then
      out%spatial_projection_pa = crota(out%axset_iy)*rad_per_deg  ! From deg to internal rad
    else
      out%spatial_projection_pa = 0.d0
    endif
  end subroutine cubeio_hfits_export_system
  !
  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) :: iaxis,velref,minus
    character(len=6) :: key
    logical :: found
    character(len=12) :: ctype,cunit,specsys
    real(kind=8) :: vres,altrpix,factor
    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
    !
    out%axset_ic = 0
    vres = 0.d0
    out%spectral_increment_value = 0.d0
    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
      minus = index(ctype,'-')
      if (minus.ne.0)  ctype = ctype(1:minus-1)  ! e.g. VELO-LSR => VELO
      !
      write(key,'(A5,I1)')  'CUNIT',iaxis
      cunit = ''
      call gfits_get_value(hfits%dict,key,found,cunit,error)
      if (error)  return
      !
      select case (ctype)
      case ('VELOCITY','VELO','VRAD')
        out%axset_name(iaxis) = 'VELOCITY'
        out%axset_kind(iaxis) = code_unit_velo
        out%axset_ic = iaxis
        ! Get scaling factor from 'unit' to m/s
        call unit_prefix_scale(cunit,'m/s',factor,error)
        if (error)  return
        ! Get scaling factor from m/s to 'interface' internal unit (km/s)
        factor = factor*1.0d-3
        out%axset_convert(ival,iaxis) = out%axset_convert(ival,iaxis)*factor
        out%axset_convert(iinc,iaxis) = out%axset_convert(iinc,iaxis)*factor
        vres = out%axset_convert(iinc,iaxis)
      case ('FREQUENCY','FREQ')
        out%axset_name(iaxis) = 'FREQUENCY'
        out%axset_kind(iaxis) = code_unit_freq
        out%axset_ic = iaxis
        ! Get scaling factor from 'unit' to Hz
        call unit_prefix_scale(cunit,'Hz',factor,error)
        if (error)  return
        ! Get scaling factor from Hz to 'interface' internal unit (MHz)
        factor = factor*1.0d-6
        out%axset_convert(ival,iaxis) = out%axset_convert(ival,iaxis)*factor
        out%axset_convert(iinc,iaxis) = out%axset_convert(iinc,iaxis)*factor
        out%spectral_increment_value  = out%axset_convert(iinc,iaxis)
      case ('LAMBDA')
        out%axset_name(iaxis) = 'LAMBDA'
        out%axset_kind(iaxis) = code_unit_unk
        out%axset_ic = iaxis
      case ('STOKES')
        out%axset_name(iaxis) = 'STOKES'
        out%axset_kind(iaxis) = code_unit_unk
      end select
      !
    enddo
    !
    ! 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(ival,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
    call gfits_get_value(hfits%dict,'RESTFREQ',found,out%spectral_signal_value,error)
    if (error)  return
    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(iref,out%axset_ic)) *  &
          out%axset_convert(iinc,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(ival,out%axset_ic) *  &
          out%axset_convert(iinc,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
    !
    ! 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
    !
    ! Resolutions
    if (out%spectral_increment_value.eq.0.d0)  &
      out%spectral_increment_value = cubetools_convert_vres2fres(vres,out%spectral_signal_value)
  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 cubedag_types
    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
    !
    ! 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,crota,cunit
    real(kind=8) :: val,inc,ref,rota
    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(crota,'(A,I1)')  'CROTA',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)
    rota = 0.d0
    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
      l = len_trim(code)+1
      code(l:8) = '------------'
      select case (in%spatial_projection_code)
      case (p_gnomonic)
        code(6:8) = 'TAN'
      case (p_ortho)
        code(6:8) = 'SIN'
      case (p_azimuthal)
        code(6:8) = 'ARC'
      case (p_stereo)
        code(6:8) = 'STG'
      case (p_aitoff)
        code(6:8) = 'AIT'
      case (p_radio)
        code(6:8) = 'GLS'
      case default
        code(6:8) = '   '
      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
      rota = in%spatial_projection_pa*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_addr8(hfits,crota,rota,'',error)
    if (error)  return
    call cubefitsio_header_addstr(hfits,cunit,axisunit,'',error)
    if (error)  return
  end subroutine cubeio_hfits_import_axis
end module cubeio_header_hfits
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
