subroutine fits2gdf(name,error)
  use gbl_message
  use gio_params
  use gio_dependencies_interfaces
  use gio_interfaces, only: fits_gildas_sub, gio_message, fits2gdf_wpr
  !---------------------------------------------------------------------
  ! @ private
  ! Automatic FITS to GDF converion
  !---------------------------------------------------------------------
  character(len=*), intent(inout)  :: name       ! File name (modified)
  logical, intent(out) :: error                  ! Error flag
  ! Local
  character(len=*), parameter :: rname='FITS2GDF'
  character(len=filename_length) :: iname,oname
  integer(kind=index_length) :: blc(gdf_maxdims),trc(gdf_maxdims)
  logical, parameter :: overwrite=.false.
  !
  call gio_message(seve%i,rname,'FITS-to-GDF automatic conversion, Version 1.1')
  !
  error=.false.
  blc = 0
  trc = 0
  !
  iname = name
  oname = trim(name)//'.gdf'
  name = oname
  !
  call fits_gildas_sub(iname,oname,' ',blc,trc,1,.false.,overwrite,error,  &
   gfits_getnosymbol,fits2gdf_wpr)
  if (error) then
    call gio_message(seve%e,rname,'Conversion failed')
    error=.true.
  else
    call gio_message(seve%i,rname,'Successful completion')
  endif
  !
end subroutine fits2gdf
!
subroutine fits2gdf_wpr(chain,answer)
  use gio_dependencies_interfaces
  use gio_interfaces, only : gio_message
  use gildas_def
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  !---------------------------------------------------------------------
  character(len=*) :: chain         !
  character(len=*) :: answer        !
  call gio_message(seve%e,'FITS2GDF','Invalid call to SIC_WPR')
  call sysexi(fatale)
end subroutine fits2gdf_wpr
!
subroutine fitscube2gdf_header(file,ihdu,fd,ghead,getsymbol,error)
  use image_def
  use gbl_message
  use gfits_types
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>fitscube2gdf_header
  !---------------------------------------------------------------------
  ! @ public
  ! Load the header of the extension currently opened in gfits and
  ! translate it as a GDF header. Suited for N-dimensional cubes only.
  !---------------------------------------------------------------------
  character(len=*),    intent(in)    :: file       ! FITS file name
  integer(kind=4),     intent(in)    :: ihdu       ! HDU we are reading (1=Primary)
  type(gfits_hdesc_t), intent(inout) :: fd         !
  type(gildas),        intent(inout) :: ghead      ! Gildas header
  external                           :: getsymbol  ! Symbol translation routine
  logical,             intent(inout) :: error      !
  ! Local
  character(len=*), parameter :: rname='FITS'
  integer(kind=4) :: fmt
  type(gfits_hdict_t) :: fhdict
  real(kind=8) :: rota(gdf_maxdims)
  logical :: found
  character(len=12) :: unit(gdf_maxdims)
  !
  ! Try to load everything, no interpretation yet
  call gfits_load_header(fhdict,.false.,getsymbol,error)
  if (error)  return
  !
  ! Get (and check) cards with precise order and values expected
  ! SIMPLE
  if (ihdu.le.0) then
    call gio_message(seve%e,rname,'Invalid HDU number')
    error = .true.
    return
  elseif (ihdu.eq.1) then
    ! We are reading the Primary HDU
    call gfits_check_simple(fhdict%card(1),error)
    if (error)  return
  else
    ! We are reading an Xtension
    call gfits_check_xtension(fhdict%card(1),error,'IMAGE')
    if (error)  return
  endif
  ! BITPIX
  call gfits_check_format(fhdict%card(2),fd%nbit,fmt,error)
  if (error)  return
  ! NAXIS*
  call fitscube2gdf_check_naxis(fhdict,ihdu,ghead%gil%ndim,ghead%gil%dim,error)
  if (error)  return
  !
  ! More general elements
  ! Axes description
  call fitscube2gdf_check_convert(fhdict,ghead%gil%convert,rota,unit,error)
  if (error)  return
  ! CD Matrix ZZZ merge with fitscube2gdf_check_convert?
  call fitscube2gdf_check_cdmatrix(fhdict,ghead%gil%convert,rota,error)
  if (error)  return
  ! Extrema
  call fitscube2gdf_check_minmax(fhdict,ghead%gil%extr_words,ghead%gil%rmin,ghead%gil%rmax,error)
  if (error)  return
  ! Array description
  call fitscube2gdf_check_array(fhdict,fd,ghead,error)
  if (error)  return
  ! Coordinate system
  call fitscube2gdf_check_system(fhdict,rota,ghead,error)
  if (error)  return
  ! Spectroscopic axis
  call fitscube2gdf_check_spec(fhdict,unit,ghead,error)
  if (error)  return
  ! Resolution section
  call fitscube2gdf_check_resolution(fhdict,ghead,error)
  if (error)  return
  ! Telescope section
  call fitscube2gdf_check_telescope(fhdict,ghead,error)
  if (error)  return
  !
  ! Miscellaneous:
  ! ZZZ to be merged in the related section!
  call gfits_get_value(fhdict,'OBJECT',found,ghead%char%name,error)
  if (error)  return
  call gfits_get_value(fhdict,'LINE',found,ghead%char%line,error)
  if (error)  return
  if (.not.found) then
    call gfits_get_value(fhdict,'LINENAME',found,ghead%char%line,error)
    if (error)  return
  endif
  !
end subroutine fitscube2gdf_header
!
subroutine fitscube2gdf_check_naxis(fhdict,ihdu,ndim,dims,error)
  use gildas_def
  use gbl_message
  use gfits_types
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>fitscube2gdf_check_naxis
  !---------------------------------------------------------------------
  ! @ private
  ! Read and check the NAXIS* values
  !---------------------------------------------------------------------
  type(gfits_hdict_t),        intent(in)    :: fhdict   !
  integer(kind=4),            intent(in)    :: ihdu     !
  integer(kind=4),            intent(out)   :: ndim     !
  integer(kind=index_length), intent(out)   :: dims(:)  !
  logical,                    intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='FITS'
  character(len=20) :: what
  !
  if (ihdu.eq.1) then
    what = 'Primary HDU'
  else
    write(what,'(A,I0)') 'HDU #',ihdu
  endif
  !
  ! NAXIS: always the 3rd card
  call gfits_check_naxis(fhdict%card(3),ndim,error)
  if (error)  return
  if (ndim.le.0) then
    call gio_message(seve%e,rname,'No image in '//what)
    error = .true.
    return
  endif
  !
  ! NAXISi
  call gfits_check_naxisi(fhdict,dims,error)
  if (error)  return
  if (any(dims(1:ndim).eq.0)) then
    call gio_message(seve%e,rname,'One or more dimensions are zero-sized in '//what)
    error = .true.
    return
  endif
  !
end subroutine fitscube2gdf_check_naxis
!
subroutine fitscube2gdf_check_convert(fhdict,convert,rota,unit,error)
  use image_def
  use gfits_types
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>fitscube2gdf_check_convert
  !---------------------------------------------------------------------
  ! @ private
  ! Translate all the CRVALi, CRPIXi, CDELTi, CTYPEi, CROTAi
  !---------------------------------------------------------------------
  type(gfits_hdict_t),  intent(in)    :: fhdict        !
  real(kind=8),         intent(out)   :: convert(:,:)  !
  real(kind=8),         intent(out)   :: rota(:)       !
  character(len=*),     intent(out)   :: unit(:)       !
  logical,              intent(inout) :: error         !
  ! Local
  integer(kind=4) :: iaxis
  character(len=6) :: key
  logical :: found
  !
  ! Defaults
  convert(1,:) = 0.d0  ! Ref
  convert(2,:) = 0.d0  ! Val
  convert(3,:) = 1.d0  ! Inc
  rota(:) = 0.d0
  unit(:) = ''
  !
  do iaxis=1,gdf_maxdims
    write(key,'(A5,I1)')  'CRPIX',iaxis
    call gfits_get_value(fhdict,key,found,convert(1,iaxis),error)
    if (error)  return
    !
    write(key,'(A5,I1)')  'CRVAL',iaxis
    call gfits_get_value(fhdict,key,found,convert(2,iaxis),error)
    if (error)  return
    !
    write(key,'(A5,I1)')  'CDELT',iaxis
    call gfits_get_value(fhdict,key,found,convert(3,iaxis),error)
    if (error)  return
    !
    write(key,'(A5,I1)')  'CROTA',iaxis
    call gfits_get_value(fhdict,key,found,rota(iaxis),error)
    if (error)  return
    !
    write(key,'(A5,I1)')  'CUNIT',iaxis
    call gfits_get_value(fhdict,key,found,unit(iaxis),error)
    if (error)  return
  enddo
  !
end subroutine fitscube2gdf_check_convert
!
subroutine fitscube2gdf_check_cdmatrix(fhdict,convert,rota,error)
  use phys_const
  use gbl_message
  use gfits_types
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>fitscube2gdf_check_cdmatrix
  !---------------------------------------------------------------------
  ! @ private
  ! Apply the CD matrix to the convert/rota arrays
  !---------------------------------------------------------------------
  type(gfits_hdict_t), intent(in)    :: fhdict        !
  real(kind=8),        intent(inout) :: convert(:,:)  !
  real(kind=8),        intent(inout) :: rota(:)       !
  logical,             intent(inout) :: error         !
  ! Local
  character(len=*), parameter :: rname='FITS'
  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(fhdict,'CD1_1',found,cd(1,1),error)
  if (error)  return
  if (found)  num = num+1
  !
  call gfits_get_value(fhdict,'CD1_2',found,cd(1,2),error)
  if (error)  return
  if (found)  num = num+1
  !
  call gfits_get_value(fhdict,'CD2_1',found,cd(2,1),error)
  if (error)  return
  if (found)  num = num+1
  !
  call gfits_get_value(fhdict,'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 gio_message(seve%w,rname,'Using CD Matrix')
  else
    call gio_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 gio_message(seve%e,rname,'CDi_j matrix is skewed')
    error = .true.
    return
  endif
  convert(3,1) = sqrt(cd(1,1)**2+cd(2,1)**2)
  convert(3,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)
    convert(3,1) = -convert(3,1)
  endif
  !
  ! Rotation ...
  angle1 = atan2(cd(2,1),cd(1,1))
  angle2 = -atan2(cd(1,2),cd(2,2))
  rota(1) = angle1*180.0d0/pi
  rota(2) = angle2*180.0d0/pi  ! Must be in degree
  !
  ! Verification de coherence: les CDELTi doivent etres a 1 ou 0, a faire...
  !
end subroutine fitscube2gdf_check_cdmatrix
!
subroutine fitscube2gdf_check_array(fhdict,fd,ghead,error)
  use gbl_message
  use image_def
  use gfits_types
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>fitscube2gdf_check_array
  !---------------------------------------------------------------------
  ! @ private
  ! Get the binary array description
  !---------------------------------------------------------------------
  type(gfits_hdict_t), intent(in)    :: fhdict   !
  type(gfits_hdesc_t), intent(inout) :: fd       !
  type(gildas),        intent(inout) :: ghead    !
  logical,             intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='FITS'
  logical :: found
  character(len=32) :: chblank
  integer(kind=8) :: i8blank
  real(kind=8) :: r8blank
  logical, parameter :: doblank=.true.  ! Should be customizable
  character(len=message_length) :: mess
  real(kind=4) :: newbval
  character(len=12) :: tempscale
  !
  call gfits_get_value(fhdict,'BUNIT',found,ghead%char%unit,error)
  if (error)  return
  !
  tempscale = ''
  call gfits_get_value(fhdict,'TEMPSCAL',found,tempscale,error)
  if (error)  return
  if (tempscale.ne.'') then
    ! Try to format to the usual Gildas encoding e.g. "K (TA*)"
    ghead%char%unit = trim(ghead%char%unit)//' ('//trim(tempscale)//')'
  endif
  !
  fd%bscal = 1.0  ! Fallback if not found
  call gfits_get_value(fhdict,'BSCALE',found,fd%bscal,error)
  if (error)  return
  !
  fd%bzero = 0.0  ! Fallback if not found
  call gfits_get_value(fhdict,'BZERO',found,fd%bzero,error)
  if (error)  return
  !
  call gfits_get_value(fhdict,'BLANK',found,chblank,error)
  if (error)  return
  !
  if (found) then
    ! BLANK is defined
    if (fd%nbit.ge.0) then  ! Indexed values
      call gfits_get_value(fhdict,'BLANK',found,i8blank,error)
      if (error)  return
      ! Note that the blanking value can be surrounded by valid values
      ghead%gil%bval = i8blank*fd%bscal + fd%bzero
      ghead%gil%eval = 0.5*fd%bscal
      ghead%gil%blan_words = 2
    else  ! Floating point values
      ! Scaling is poor style for floats, but not strictly forbidden...
      call gfits_get_value(fhdict,'BLANK',found,r8blank,error)
      if (error)  return
      ghead%gil%bval = r8blank*fd%bscal + fd%bzero
      ghead%gil%eval = 0.
      ghead%gil%blan_words = 2
    endif
    fd%bval0 = ghead%gil%bval  ! Actual blanking value used by the data
  else
    ! BLANK is not defined
    if (fd%nbit.ge.0) then  ! Indexed values
      ghead%gil%blan_words = 0  ! No blanking in header => no blanking in data
      fd%bval0 = 0.  ! Unused
      return  ! Leave section disabled
    else  ! Floating point values
      ghead%gil%blan_words = 0  ! No blanking value, but maybe NaN to be patched
      call gag_notanum(fd%bval0)  ! Actual blanking value used by the data
    endif
  endif
  !
  if (.not.doblank)  return  ! Leave blank values in data "as is"
  !
  ! Try to define a cleverer blanking value.
  if (ghead%gil%rmin.lt.ghead%gil%rmax) then
    ! OK: DATAMIN and DATAMAX were defined. Select a round blanking value
    ! below DATAMIN
    if (ghead%gil%rmin.gt.-1000.0) then
      newbval = -1000.0
    else
      newbval = -10**ceiling(log10(-ghead%gil%rmin))
    endif
    write(mess,'(A,1X,F0.1)')  'Removing NaN with blanking value',newbval
    call gio_message(seve%w,rname,mess)
  else
    ! We should design the blanking value according to data min value, but
    ! this requires searching for the latter in first loop, and then patching
    ! NaN in a second loop. Cost is too large...
    call gio_message(seve%w,rname,'Removing NaN with default blanking value -1000.0')
    newbval = -1000.0
  endif
  !
  ! Define or update the blanking section
  ghead%gil%blan_words = 2
  ghead%gil%bval = newbval
  ghead%gil%eval = 0.
  !
end subroutine fitscube2gdf_check_array
!
subroutine fitscube2gdf_check_minmax(fhdict,nwords,datamin,datamax,error)
  use gfits_types
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>fitscube2gdf_check_minmax
  !---------------------------------------------------------------------
  ! @ private
  ! Get the binary array description
  !---------------------------------------------------------------------
  type(gfits_hdict_t), intent(in)    :: fhdict    !
  integer(kind=4),     intent(out)   :: nwords    !
  real(kind=4),        intent(out)   :: datamin   !
  real(kind=4),        intent(out)   :: datamax   !
  logical,             intent(inout) :: error     !
  ! Local
  logical :: found
  !
  nwords = 0
  !
  call gfits_get_value(fhdict,'DATAMIN',found,datamin,error)
  if (error)  return
  if (found)  nwords = nwords+1
  !
  call gfits_get_value(fhdict,'DATAMAX',found,datamax,error)
  if (error)  return
  if (found)  nwords = nwords+1
  !
end subroutine fitscube2gdf_check_minmax
!
subroutine fitscube2gdf_check_system(fhdict,rota,ghead,error)
  use phys_const
  use gbl_message
  use image_def
  use gfits_types
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>fitscube2gdf_check_system
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gfits_hdict_t), intent(in)    :: fhdict    !
  real(kind=8),        intent(in)    :: rota(:)   !
  type(gildas),        intent(inout) :: ghead     !
  logical,             intent(inout) :: error     !
  ! Local
  character(len=*), parameter :: rname='FITS'
  integer(kind=4) :: iaxis,minus,ier
  character(len=6) :: key
  logical :: found
  character(len=12) :: rccode,suffix,pname
  character(len=80) :: value
  real(kind=4) :: xoff,yoff
  character(len=message_length) :: mess
  !
  ! Default equinox (NB: FITS says RADESYS defaults to FK5 is absent, i.e.
  ! there is a valid default system and equinox...)
  ghead%char%syst = ''
  ghead%gil%epoc = equinox_null
  !
  ! System and optionally equinox
  call gfits_get_value(fhdict,'RADESYS',found,value,error)
  if (error)  return
  if (.not.found) then  ! Try deprecated RADECSYS
    call gfits_get_value(fhdict,'RADECSYS',found,value,error)
    if (error)  return
  endif
  if (found) then
    ! From RADESYS
    if (value(1:8).eq.'FK4-NO-E') then
      ghead%char%syst = 'EQUATORIAL'
      ghead%gil%epoc = 1950.0
    elseif (value(1:3).eq.'FK4') then
      ghead%char%syst = 'EQUATORIAL'
      ghead%gil%epoc = 1950.0
    elseif (value(1:3).eq.'FK5') then
      ghead%char%syst = 'EQUATORIAL'
      ghead%gil%epoc = 2000.0
    elseif (value(1:4).eq.'ICRS') then
      ghead%char%syst = 'ICRS'
      ghead%gil%epoc = equinox_null  ! Irrelevant for ICRS
    endif
  endif
  !
  ! EQUINOX (or EPOCH)
  call gfits_get_value(fhdict,'EQUINOX',found,value,error)
  if (error)  return
  if (.not.found) then
    call gfits_get_value(fhdict,'EPOCH',found,value,error)
    if (error)  return
  endif
  if (found) then
    read(value,*,iostat=ier) ghead%gil%epoc
    if (ier.ne.0) then
      if (value(1:1).eq.'J') then
        read(value(2:),*,iostat=ier) ghead%gil%epoc
      elseif (value(1:1).eq.'B') then
        read(value(2:),*,iostat=ier) ghead%gil%epoc
      endif
      if (ier.ne.0) then
        call gio_message(seve%e,rname,'Undecipherable Equinox '//value)
        ghead%gil%epoc = equinox_null
      endif
    endif
  endif
  !
  ! System description
  pname = ' '
  ghead%gil%xaxi = 0
  ghead%gil%yaxi = 0
  do iaxis=1,ghead%gil%ndim
    !
    write(key,'(A5,I1)')  'CTYPE',iaxis
    call gfits_get_value(fhdict,key,found,rccode,error)
    if (error)  return
    if (.not.found) then
      write(mess,'(A,I0,3A)')  'File has ',ghead%gil%ndim,' dimensions but ',  &
        trim(key),' is not defined'
      call gio_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 (ghead%char%syst.eq.'') then
        ! RA is ambiguously used for EQUATORIAL or ICRS
        call gio_message(seve%w,rname,'Coordinate system assumed EQUATORIAL')
        ghead%char%syst      = 'EQUATORIAL'
      endif
      ghead%gil%xaxi         = iaxis
      ghead%char%code(iaxis) = 'RA'
      ghead%gil%ra           = ghead%gil%convert(2,iaxis)*rad_per_deg
      ghead%gil%a0           = ghead%gil%ra
      pname = suffix
    case ('DEC')
      if (ghead%char%syst.eq.'') then
        ! DEC is ambiguously used for EQUATORIAL or ICRS
        call gio_message(seve%w,rname,'Coordinate system assumed EQUATORIAL')
        ghead%char%syst      = 'EQUATORIAL'
      endif
      ghead%gil%yaxi         = iaxis
      ghead%char%code(iaxis) = 'DEC'
      ghead%gil%dec          = ghead%gil%convert(2,iaxis)*rad_per_deg
      ghead%gil%d0           = ghead%gil%dec
      pname = suffix
    case ('LON','GLON')
      ghead%char%syst        = 'GALACTIC'
      ghead%gil%xaxi         = iaxis
      ghead%char%code(iaxis) = 'LII'
      ghead%gil%lii          = ghead%gil%convert(2,iaxis)*rad_per_deg
      ghead%gil%a0           = ghead%gil%lii
      pname = suffix
    case ('LAT','GLAT')
      ghead%char%syst        = 'GALACTIC'
      ghead%gil%yaxi         = iaxis
      ghead%char%code(iaxis) = 'BII'
      ghead%gil%bii          = ghead%gil%convert(2,iaxis)*rad_per_deg
      ghead%gil%d0           = ghead%gil%bii
      pname = suffix
    case default
      cycle
    end select
    !
    ! Factorized for all of the 4 cases:
    ghead%gil%convert(2,iaxis) = 0.d0
    ghead%gil%convert(3,iaxis) = ghead%gil%convert(3,iaxis)*rad_per_deg
    ghead%gil%desc_words       = 1
    !
  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 gio_message(seve%w,rname,'Projection assumed CARTESIAN')
    ghead%gil%ptyp = p_cartesian
  case ('TAN')
    ghead%gil%ptyp = p_gnomonic
  case ('ATF')  ! Aitof
    ghead%gil%ptyp = 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.
    ghead%gil%ptyp = p_ortho  ! Orthographic or Dixon
  case ('ARC')
    ghead%gil%ptyp = p_azimuthal  ! Schmidt or Azimuthal
  case ('STG')  ! Stereographic
    ghead%gil%ptyp = p_stereo
  case ('GLS')
    ghead%gil%ptyp = p_radio
  case ('CAR')  ! Cartesian
    ghead%gil%ptyp = p_cartesian
  case ('SFL')
    ghead%gil%ptyp = 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).
    ghead%gil%ptyp = p_ncp
  case default
    call gio_message(seve%w,rname,'Unrecognized projection '//pname)
    ghead%gil%ptyp = p_none
  end select
  ! Projection angle. Can be defined in CROTA2 but not CROTA1.
  if (ghead%gil%xaxi.ne.0 .and. rota(ghead%gil%xaxi).ne.0.d0) then
    ghead%gil%pang = rota(ghead%gil%xaxi)*rad_per_deg  ! From deg to internal rad
  elseif (ghead%gil%yaxi.ne.0 .and. rota(ghead%gil%yaxi).ne.0.d0) then
    ghead%gil%pang = rota(ghead%gil%yaxi)*rad_per_deg  ! From deg to internal rad
  else
    ghead%gil%pang = 0.d0
  endif
  !
  ! Set the alternate system
  xoff = 0.
  yoff = 0.
  if (ghead%char%syst.eq.'EQUATORIAL') then
    if (ghead%gil%epoc.ne.equinox_null)  &
    call equ_to_gal(ghead%gil%ra,ghead%gil%dec,xoff,yoff,ghead%gil%epoc,  &
                    ghead%gil%lii,ghead%gil%bii,xoff,yoff,error)
  elseif (ghead%char%syst.eq.'GALACTIC') then
    if (ghead%gil%epoc.eq.equinox_null)  ghead%gil%epoc = 2000.0
    call gal_to_equ(ghead%gil%lii,ghead%gil%bii,xoff,yoff,  &
                    ghead%gil%ra,ghead%gil%dec,xoff,yoff,ghead%gil%epoc,error)
  elseif (ghead%char%syst.eq.'ICRS') then
    ! Converting from ICRS is not yet implemented
    ghead%gil%lii = 0.d0
    ghead%gil%bii = 0.d0
  endif
  !
end subroutine fitscube2gdf_check_system
!
subroutine fitscube2gdf_check_spec(fhdict,unit,ghead,error)
  use phys_const
  use gbl_message
  use image_def
  use gfits_types
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>fitscube2gdf_check_spec
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gfits_hdict_t), intent(in)    :: fhdict    !
  character(len=*),    intent(in)    :: unit(:)   !
  type(gildas),        intent(inout) :: ghead     !
  logical,             intent(inout) :: error     !
  ! Local
  character(len=*), parameter :: rname='FITS'
  integer(kind=4) :: iaxis,velref,minus
  character(len=6) :: key
  logical :: found
  character(len=12) :: value
  real(kind=8) :: altrpix,factor
  integer(kind=4), parameter :: iref=1,ival=2,iinc=3
  !
  ! Velocity type
  ! ghead%gil%vtyp = default set by gildas_null
  call gfits_get_value(fhdict,'SPECSYS',found,value,error)
  if (error)  return
  if (found) then
    select case (value)
    case ('LSRK')
      ghead%gil%vtyp = vel_lsr
    case ('HEL')
      ghead%gil%vtyp = vel_hel
    case ('TOPOCENT')
      ghead%gil%vtyp = vel_obs
    case default
      call gio_message(seve%w,rname,'SPECSYS '//trim(value)//' not understood')
    end select
  else
    ! VELREF: >256 RADIO, 1 LSR 2 HEL 3 OBS
    call gfits_get_value(fhdict,'VELREF',found,velref,error)
    if (error)  return
    if (found) then
      if (velref.gt.256)  velref = velref-256
      select case (velref)
      case (1)
        ghead%gil%vtyp = vel_lsr
      case (2)
        ghead%gil%vtyp = vel_hel
      case (3)
        ghead%gil%vtyp = vel_obs
      case default
        call gio_message(seve%w,rname,'Invalid VELREF, velocity type set to default')
      end select
    endif
  endif
  !
  ! System description
  ghead%gil%spec_words = 0
  ghead%gil%faxi = 0
  do iaxis=1,ghead%gil%ndim
    !
    write(key,'(A5,I1)')  'CTYPE',iaxis
    call gfits_get_value(fhdict,key,found,value,error)
    if (error)  return
    minus = index(value,'-')
    if (minus.ne.0)  value = value(1:minus-1)  ! e.g. VELO-LSR => VELO
    !
    select case (value)
    case ('VELOCITY','VELO','VRAD')
      ghead%char%code(iaxis) = 'VELOCITY'
      ghead%gil%faxi = iaxis
      ! Get scaling factor from 'unit' to m/s
      call unit_prefix_scale(unit(iaxis),'m/s',factor,error)
      if (error)  return
      ! Get scaling factor from m/s to Gildas internal unit (km/s)
      factor = factor*1.0d-3
      ghead%gil%convert(ival,iaxis) = ghead%gil%convert(ival,iaxis)*factor
      ghead%gil%convert(iinc,iaxis) = ghead%gil%convert(iinc,iaxis)*factor
      ghead%gil%vres = ghead%gil%convert(iinc,iaxis)
      ghead%gil%spec_words = 12
    case ('FREQUENCY','FREQ')
      ghead%char%code(iaxis) = 'FREQUENCY'
      ghead%gil%faxi = iaxis
      ! Get scaling factor from 'unit' to Hz
      call unit_prefix_scale(unit(iaxis),'Hz',factor,error)
      if (error)  return
      ! Get scaling factor from Hz to Gildas internal unit (MHz)
      factor = factor*1.0d-6
      ghead%gil%convert(ival,iaxis) = ghead%gil%convert(ival,iaxis)*factor
      ghead%gil%convert(iinc,iaxis) = ghead%gil%convert(iinc,iaxis)*factor
      ghead%gil%fres = ghead%gil%convert(iinc,iaxis)
      ghead%gil%spec_words = 12
    case ('LAMBDA')
      ghead%char%code(iaxis) = 'LAMBDA'
      ghead%gil%faxi = iaxis
      ghead%gil%spec_words = 12
    case ('STOKES')
      ghead%char%code(iaxis) = 'STOKES'
    end select
    !
  enddo
  !
  if (ghead%gil%spec_words.eq.0)  return
  !
  ! Velocity offset
  call gfits_get_value(fhdict,'VELO-LSR',found,ghead%gil%voff,error)
  if (error)  return
  if (found) then
    ! Up to now VELO-LSR has no known unit => assume m/s, convert to km/s
    ghead%gil%voff = ghead%gil%voff*1e-3
  else
    ! No VELO-LSR keyword
    if (ghead%char%code(ghead%gil%faxi).eq.'VELOCITY') then
      ghead%gil%voff = ghead%gil%convert(ival,ghead%gil%faxi)  ! Already in Gildas internal unit
    else
      ! No velocity axis nor velocity offset...
      call gio_message(seve%w,rname,'Missing velocity description')
    endif
  endif
  !
  ! Rest frequency
  call gfits_get_value(fhdict,'RESTFREQ',found,ghead%gil%freq,error)
  if (error)  return
  if (.not.found) then
    call gfits_get_value(fhdict,'RESTFRQ',found,ghead%gil%freq,error)
    if (error)  return
  endif
  if (.not.found .and. ghead%char%code(ghead%gil%faxi).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 gio_message(seve%w,rname,'Deriving rest frequency from ALTRVAL/ALTRPIX')
    call gfits_get_value(fhdict,'ALTRVAL',found,ghead%gil%freq,error)
    if (error)  return
    call gfits_get_value(fhdict,'ALTRPIX',found,altrpix,error)
    if (error)  return
    if (found) then
      ! Frequency at ref. channel (in case it is different from ALTRPIX)
      ghead%gil%freq = ghead%gil%freq -  &
                       (altrpix-ghead%gil%convert(iref,ghead%gil%faxi)) *  &
                       ghead%gil%convert(iinc,ghead%gil%faxi) * ghead%gil%freq / clight_kms
      ! Rest frequency corresponds to velocity = 0 (LSR frame)
      ghead%gil%freq = ghead%gil%freq -  &
                       ghead%gil%convert(ival,ghead%gil%faxi) *  &
                       ghead%gil%convert(iinc,ghead%gil%faxi) * ghead%gil%freq / clight_kms
    endif
  endif
  ! Up to now RESTFREQ has no known unit => assume Hz, convert to MHz
  ghead%gil%freq = ghead%gil%freq*1d-6
  !
  ! Image frequency
  call gfits_get_value(fhdict,'IMAGFREQ',found,ghead%gil%fima,error)
  if (error)  return
  ghead%gil%fima = ghead%gil%fima*1d-6  ! Assume Hz, convert to MHz
  !
  ! Resolutions
  if (ghead%gil%vres.eq.0.)  ghead%gil%vres = - clight_kms * ghead%gil%fres / ghead%gil%freq
  if (ghead%gil%fres.eq.0.)  ghead%gil%fres = - ghead%gil%freq * ghead%gil%vres / clight_kms
  !
end subroutine fitscube2gdf_check_spec
!
subroutine fitscube2gdf_check_resolution(fhdict,ghead,error)
  use phys_const
  use image_def
  use gfits_types
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>fitscube2gdf_check_resolution
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gfits_hdict_t), intent(in)    :: fhdict  !
  type(gildas),        intent(inout) :: ghead   !
  logical,             intent(inout) :: error   !
  ! Local
  character(len=*), parameter :: rname='FITS'
  logical :: found
  !
  ghead%gil%majo = 0.
  call gfits_get_value(fhdict,'BMAJ',found,ghead%gil%majo,error)
  if (error)  return
  if (found) then
    ghead%gil%reso_words = 3
    ghead%gil%majo = ghead%gil%majo*rad_per_deg
  endif
  !
  ghead%gil%mino = 0.
  call gfits_get_value(fhdict,'BMIN',found,ghead%gil%mino,error)
  if (error)  return
  if (found) then
    ghead%gil%reso_words = 3
    ghead%gil%mino = ghead%gil%mino*rad_per_deg
  endif
  !
  ghead%gil%posa = 0.
  call gfits_get_value(fhdict,'BPA', found,ghead%gil%posa,error)
  if (error)  return
  if (found) then
    ghead%gil%reso_words = 3
    ghead%gil%posa = ghead%gil%posa*rad_per_deg
  endif
  !
end subroutine fitscube2gdf_check_resolution
!
subroutine fitscube2gdf_check_telescope(fhdict,ghead,error)
  use phys_const
  use image_def
  use gfits_types
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>fitscube2gdf_check_telescope
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gfits_hdict_t), intent(in)    :: fhdict  !
  type(gildas),        intent(inout) :: ghead   !
  logical,             intent(inout) :: error   !
  ! Local
  character(len=*), parameter :: rname='FITS'
  logical :: found
  character(len=12) :: telescope
  real(kind=8) :: dummy(3)
  !
  call gfits_get_value(fhdict,'TELESCOP',found,telescope,error)
  if (error)  return
  if (found) then
    call gdf_addteles(ghead,'TELE',telescope,dummy,error)
    if (error)  error = .false.  ! Most likely the telescope name was not found
  endif
  !
end subroutine fitscube2gdf_check_telescope
!
subroutine fitscube2gdf_patch_bval(fd,ghead,data,ndata,error)
  use gildas_def
  use image_def
  use gio_interfaces, except_this=>fitscube2gdf_patch_bval
  use gfits_types
  !---------------------------------------------------------------------
  ! @ public
  ! Patch blanking values to a better value in input data array
  !---------------------------------------------------------------------
  type(gfits_hdesc_t),       intent(in)    :: fd           !
  type(gildas),              intent(in)    :: ghead        !
  integer(kind=size_length), intent(in)    :: ndata        !
  real(kind=4),              intent(inout) :: data(ndata)  !
  logical,                   intent(inout) :: error        !
  ! Local
  integer(kind=size_length) :: i
  !
  ! If no blanking value was (re)defined in the header, there is nothing
  ! we can patch in the data:
  if (ghead%gil%blan_words.eq.0)  return
  !
  ! Patch the data
  if (fd%bval0.ne.fd%bval0) then
    ! Actual blanking value is NaN
    do i=1,ndata
      if (data(i).ne.data(i))  data(i) = ghead%gil%bval
    enddo
  elseif (fd%bval0.ne.ghead%gil%bval) then
    ! Actual blanking value is standard float
    do i=1,ndata
      if (data(i).eq.fd%bval0)  data(i) = ghead%gil%bval
    enddo
  endif
  !
end subroutine fitscube2gdf_patch_bval
!
subroutine fits2gdf_guess_style(style,error)
  use gbl_message
  use gio_params
  use gfits_types
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>fits2gdf_guess_style
  use gio_fitsdef
  !---------------------------------------------------------------------
  ! @ private
  !  Guess the style of the extension currently opened in GFITS
  !---------------------------------------------------------------------
  integer(kind=4), intent(out)   :: style
  logical,         intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='FITS'
  type(gfits_hdict_t) :: fhdict
  logical :: groups,found
  !
  ! Load the whole header for simplicity. No symbol translation as
  ! there is no purpose user overrides the checks on NAXIS* in this
  ! subroutine.
  call gfits_load_header(fhdict,.false.,gfits_getnosymbol,error)
  if (error)  return
  !
  ! Minimum sanity checks: they will be the responsibility of the full filler
  groups = .false.
  call gfits_get_value(fhdict,'GROUPS',found,groups,error)
  if (error)  return
  !
  if (groups) then
    ! Rely on the GROUPS keyword. Checking if NAXIS1 is 0 is not 100%
    ! reliable as it can be 0 for exotic (but valid) data in other
    ! styles (e.g. zero-sized columns in a BINTABLE).
    call gio_message(seve%i,rname,'FITS file may be UVFITS, trying...')
    style = code_fits_uvfits
  else
    style = code_fits_standard
    call gio_message(seve%i,rname,'FITS file may be IMAGE, trying...')
  endif
  !
  ! Rewind position to start of current extension, so that the filler
  ! can read the header as it wants
  call gfits_rewind_hdu(error)
  if (error)  return
  !
end subroutine fits2gdf_guess_style
!
subroutine unit_prefix_scale(prefix,unit,scale,error)
  use gbl_message
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>unit_prefix_scale
  !---------------------------------------------------------------------
  ! @ private
  ! Find the scaling factor to go from 'unit' (e.g. 'Hz') to prefix
  ! (e.g. 'MHz').
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: prefix  ! Prefixed unit
  character(len=*), intent(in)    :: unit    ! Natural unit
  real(kind=8),     intent(out)   :: scale   ! Scaling factor
  logical,          intent(inout) :: error   ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='FITS'
  integer(kind=4) :: kunit
  character(len=12) :: u_unit
  character(len=24) :: u_prefix
  !
  scale = 1.d0
  !
  if (prefix.eq.' ') return  ! Empty assumes natural unit
  !
  u_prefix = prefix
  call sic_upper(u_prefix)
  u_unit = unit
  call sic_upper(u_unit)
  kunit = index(u_prefix,u_unit)
  !
  if (kunit.eq.0) then
    ! Unit recognized at all...
    call gio_message(seve%w,rname,'Non-supported unit '//prefix)
    return
  else if (kunit.eq.1) then
    ! No prefix multiplier
    return
  else if (u_prefix(kunit:).ne.u_unit) then
    ! Not a prefix multiplier
    return
  else if (kunit.gt.3)  then
    ! Prefix multiplier can only have 1 or 2 letters
    call gio_message(seve%w,rname,'Non-supported prefix in unit '//prefix)
    return
  else if (kunit.eq.3) then
    ! The only Prefix multiplier with 2 letters is "da" for "deca"
    if (prefix(1:2).eq.'da') then
      scale = 10.d0
    else
      call gio_message(seve%w,rname,'Non-supported prefix in unit '//prefix)
    endif
    return
  endif
  !
  ! NB: tests are done on non-upcased prefix
  select case (prefix(1:1))
  case ('d')
    scale = 1.d-1
  case ('c')
    scale = 1.d-2
  case ('m')
    scale = 1.d-3
  case ('u')
    scale = 1.d-6
  case ('n')
    scale = 1.d-9
  case ('p')
    scale = 1.d-12
  case ('f')
    scale = 1.d-15
  case ('a')
    scale = 1.d-18
  case ('z')
    scale = 1.d-21
  case ('y')
    scale = 1.d-24
  case ('h')
    scale = 1.d2
  case ('k')
    scale = 1.d3
  case ('M')
    scale = 1.d6
  case ('G')
    scale = 1.d9
  case ('T')
    scale = 1.d12
  case ('P')
    scale = 1.d15
  case ('E')
    scale = 1.d18
  case ('Z')
    scale = 1.d21
  case ('Y')
    scale = 1.d24
  case default
    call gio_message(seve%w,rname,'Non-supported prefix in unit '//prefix)
    scale = 1.d0
  end select
  !
end subroutine unit_prefix_scale
