subroutine to_imfits(fits,check,error)
  use gildas_def
  use phys_const
  use gbl_message
  use image_def
  use gio_dependencies_interfaces, no_interface=>gr4_extrema
  use gio_interfaces, except_this=>to_imfits
  use gio_fitsdef
  !---------------------------------------------------------------------
  ! @ private
  ! FITS
  !       Write a GDF-image onto FITS tape
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: fits   !
  logical,      intent(in)    :: check  ! Verbose flag
  logical,      intent(inout) :: error  ! Error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=80) :: line
  character(len=12) :: specsyscode
  character(len=23) :: date
  real(kind=8) :: altrval, altrpix
  integer(kind=4) :: i, fits_naxis, velrefcode
  integer(kind=size_length) :: imin,imax,nfill
  integer(kind=address_length) :: ip
  !
  ip = gag_pointer(fits%loca%addr,memory)
  !
  !                    123456789012345678901234567890
  fd%nb = 0
  call gfits_put('SIMPLE  =                    T         /',check,error)
  if (error) goto 99
  write (line,10) 'BITPIX  =           ',fd%snbit
  call gfits_put(line,check,error)
  if (error) goto 99
  !
  ! Define the axes
  fits_naxis = fits%gil%ndim
  write(line,10) 'NAXIS   =           ',fits_naxis
  call gfits_put(line,check,error)
  if (error) goto 99
  do i=1,fits_naxis
    write (line,11) 'NAXIS',i,'  =           ',fits%gil%dim(i)
    call gfits_put(line,check,error)
    if (error) goto 99
  enddo
  !
  ! Compute extrema: if missing section, or if section present but
  ! its values are obviously wrong (unset)
  if (fits%gil%extr_words.eq.0 .or.  &
     (fits%gil%extr_words.ne.0 .and.  &
        (any(fits%gil%minloc(1:fits%gil%ndim).eq.0) .or.  &
         any(fits%gil%maxloc(1:fits%gil%ndim).eq.0) ))) then
    if (fits%gil%blan_words.eq.0) fits%gil%eval = -1.0
    call gr4_extrema(fits%loca%size,memory(ip),fits%gil%bval,fits%gil%eval, &
                     fits%gil%rmin,fits%gil%rmax,imin,imax)
  endif
  if (fd%snbit.gt.0) then
    if (fd%snbit.eq.16) then
      fd%bscal = (fits%gil%rmax - fits%gil%rmin) / 65534.0
      if (fd%bscal.eq.0.0) fd%bscal = 1.0
      fd%bzero = fits%gil%rmin + fd%bscal * 32768.0
    elseif (fd%snbit.eq.32) then
      fd%bscal = (fits%gil%rmax - fits%gil%rmin) / 4294967294.
      fd%bscal = fd%bscal * (1.0+2.0*epsilon(1.0))  ! Allow some room for roundoff
      if (fd%bscal.eq.0.0) fd%bscal = 1.0
      fd%bzero = fits%gil%rmin + fd%bscal * 2147483648.
    endif
    write (line,20) 'BSCALE  = ',fd%bscal
    call gfits_put(line,check,error)
    if (error) goto 99
    write (line,20) 'BZERO   = ',fd%bzero
    call gfits_put(line,check,error)
    if (error) goto 99
    if (fd%snbit.eq.16) then
      write (line,10) 'BLANK   =           ',32767,'Blanking value'
      call gfits_put(line,check,error)
      if (error) goto 99
    elseif (fd%snbit.eq.32) then
      write (line,10) 'BLANK   =           ',2147483647,'Blanking value'
      call gfits_put(line,check,error)
      if (error) goto 99
    endif
  endif
  write (line,20) 'DATAMIN = ',fits%gil%rmin
  call gfits_put(line,check,error)
  if (error) goto 99
  write (line,20) 'DATAMAX = ',fits%gil%rmax
  call gfits_put(line,check,error)
  if (error) goto 99
  if (lenc(fits%char%unit).gt.0) then
    call gfits_put('BUNIT   = '''//fits%char%unit//'''               /',check,error)
  else
    call gfits_put('BUNIT   = '''//'UNKNOWN     '//'''               /',check,  &
    error)
  endif
  if (error) goto 99
  !
  ! NOISE
  if (fits%gil%nois_words.gt.0) then
    write (line,20) 'NOISETHE= ',fits%gil%noise,'Theoretical noise'
    call gfits_put(line,check,error)
    if (error) goto 99
    write (line,20) 'NOISEMEA= ',fits%gil%rms,'Measured noise'
    call gfits_put(line,check,error)
    if (error) goto 99
  endif
  !
  ! Axis
  if (fits%gil%desc_words.eq.0) then  ! Protection against junk...
    do i=1,gdf_maxdims
      fits%char%code(i) = 'UNKNOWN'
    enddo
    fits%char%syst = 'UNKNOWN'
    fits%char%unit = 'UNKNOWN'
  endif
  do i=1,fits_naxis 
    call write_axis(fits,i,check,error)
    if (error) goto 99
  enddo
  ! Divers
  call gfits_put('OBJECT  = '''//fits%char%name//'''               /',check,error)
  if (error) goto 99
  if (fits%char%syst.eq.'GALACTIC') then
    write (line,20) 'GLAT    = ',180.d0*fits%gil%lii/pi,'Galactic latitude'
    call gfits_put(line,check,error)
    if (error) goto 99
    write (line,20) 'GLON    = ',180.d0*fits%gil%bii/pi,'Galactic longitude'
    call gfits_put(line,check,error)
    if (error) goto 99
    write (line,20) 'EQUINOX = ',fits%gil%epoc
    call gfits_put(line,check,error)
    if (error) goto 99
  elseif (fits%char%syst.eq.'EQUATORIAL') then
    if (nearly_equal(fits%gil%epoc,2000.,1e-6)) then
      write (line,13) 'RADESYS = ','FK5','Coordinate system'
      call gfits_put(line,check,error)
      if (error) goto 99
    endif
    write (line,20) 'RA      = ',180.d0*fits%gil%ra/pi,'Right Ascension'
    call gfits_put(line,check,error)
    if (error) goto 99
    write (line,20) 'DEC     = ',180.d0*fits%gil%dec/pi,'Declination'
    call gfits_put(line,check,error)
    if (error) goto 99
    write (line,20) 'EQUINOX = ',fits%gil%epoc
    call gfits_put(line,check,error)
    if (error) goto 99
  elseif (fits%char%syst.eq.'ICRS') then
    write (line,13) 'RADESYS = ','ICRS','Coordinate system'
    call gfits_put(line,check,error)
    if (error) goto 99
    write (line,20) 'RA      = ',180.d0*fits%gil%ra/pi,'Right Ascension'
    call gfits_put(line,check,error)
    if (error) goto 99
    write (line,20) 'DEC     = ',180.d0*fits%gil%dec/pi,'Declination'
    call gfits_put(line,check,error)
    if (error) goto 99
  elseif (fits%gil%ptyp.ne.p_none) then
    write (line,40) 'COMMENT Unknown coordinate system'
    call gfits_put(line,check,error)
    if (error) goto 99
  endif
  !
  ! Frequency / Velocity axis
  if (fits%gil%spec_words.ne.0) then
    write (line,40) 'LINE    = '''//fits%char%line//'''               /'
    call gfits_put(line,check,error)
    if (fits%gil%faxi.eq.0) then
      call gio_message(seve%w,'TO_IMFITS','No frequency axis')
    else
      altrpix = fits%gil%convert(1,fits%gil%faxi)
      write(line,20) 'ALTRPIX = ',altrpix    ! Ref. pixel from header
      call gfits_put(line,check,error)
      if (fits%char%code(fits%gil%faxi).eq.'FREQUENCY') then 
        altrval = fits%gil%convert(2,fits%gil%faxi)  ! Freq. at ref. pixel   
        altrval = 299792.458d0*(1d0-altrval/fits%gil%freq)  ! Velocity  = c*(1-z) 
        altrval = fits%gil%voff*1d3              ! km/s to m/s        
      else
        altrval = fits%gil%convert(2,fits%gil%faxi) ! Velocity at ref. pixel 
        altrval = (fits%gil%freq-altrval*fits%gil%freq/299792.458d0)  ! Freq. at ref. pixel
        altrval = altrval*1d6  ! GHz to Hz
      endif
      write(line,20) 'ALTRVAL = ',altrval ! Freq. at ref. pixel
      call gfits_put(line,check,error)
      write(line,20) 'RESTFREQ= ',fits%gil%freq*1d6 ! Rest frequency
      call gfits_put(line,check,error)
      if (fits%gil%fima.gt.0.d0) then
        write(line,20) 'IMAGFREQ= ',fits%gil%fima*1d6 ! Image frequency
        call gfits_put(line,check,error)
      endif
      ! Do not write anymore...
      !!    write(line,20) 'VELREF  = ',fits%gil%voff*1d5  ! km/s to cm/s unfortunately
      !!    call gfits_put(line,check,error)
      ! Use a more proper keyword instead
      !   convention AIPS: velref = 0 ==> none, 1 2 3 = LSR, Sun, Obs +256 if radio
      if (fits%gil%vtyp.eq.vel_lsr) then
        write(line,20) 'VELO-LSR= ',fits%gil%voff*1d3  ! km/s to m/s
        call gfits_put(line,check,error)
        velrefcode = 257  ! code for LSR velocities
        specsyscode = 'LSRK'
      elseif (fits%gil%vtyp.eq.vel_hel) then
        write(line,20) 'VELO-HEL= ',fits%gil%voff*1d3  ! km/s to m/s
        call gfits_put(line,check,error)
        velrefcode = 258  ! code for Heliocentric velocities
        specsyscode = 'BARYCENT'
      elseif (fits%gil%vtyp.eq.vel_obs) then
        write(line,20) 'VELO-OBS= ',fits%gil%voff*1d3  ! km/s to m/s
        call gfits_put(line,check,error)
        velrefcode = 259  ! code for Observatory 
        specsyscode = 'TOPOCENT'
      else
        write(line,20) 'VELOCITY= ',fits%gil%voff*1d3  ! km/s to m/s
        call gfits_put(line,check,error)
        velrefcode = 0  
        specsyscode = ' '
      endif
      write(line,10) 'VELREF  =           ', velrefcode
      call gfits_put(line,check,error)
      write(line,40) 'SPECSYS = '''//specsyscode//'''               /'
      call gfits_put(line,check,error)
    endif
  endif
  !
  if (fits%gil%reso_words.ne.0) then
    write (line,20) 'BMAJ    = ',fits%gil%majo*180.0/pi
    call gfits_put(line,check,error)
    if (error) goto 99
    write (line,20) 'BMIN    = ',fits%gil%mino*180.0/pi
    call gfits_put(line,check,error)
    if (error) goto 99
    write (line,20) 'BPA     = ',fits%gil%posa*180.0/pi
    call gfits_put(line,check,error)
    if (error) goto 99
  endif
  !
  ! Miscellaneous
  call gfits_put('ORIGIN  = ''GILDAS Consortium  ''        /',check,error)
  if (error) goto 99
  ! New ISO Date Format
  call sic_isodate(date)
  write (line,13) 'DATE    = ',trim(date),'Date written'
  call gfits_put(line,check,error)
  if (error) goto 99
  !
  ! Finish Header, Write data
  call gfits_put('END                         ',check,error)
  if (error) goto 99
  call gfits_flush_header(error)
  if (error) goto 99
  call write_all(fd,memory(ip),fits%loca%size,nfill,fits%gil%bval,fits%gil%eval,error)
  call gfits_flush_data(error)
  if (error) goto 99
  return
  !
99 error = .true.
  return
  !
10 format(a,i10,'         / ',a)
11 format(a,i1,a,i10,'         / ',a)
13 format(a,'''',a,'''',t40,'/ ',a)
20 format(a,e20.13,'         / ',a)
40 format(a)
end subroutine to_imfits
!
subroutine write_axis(fits,axis_number,check,error)
  use phys_const
  use image_def
  use gbl_message
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>write_axis
  !---------------------------------------------------------------------
  ! @ private
  ! FITS
  ! Try to write a sensible output axis name and units, according to
  ! standard FITS (stupid) conventions which requires degrees instead
  ! of Radians...
  !---------------------------------------------------------------------
  type(gildas),    intent(in)    :: fits         !
  integer(kind=4), intent(in)    :: axis_number  ! Axis number
  logical,         intent(in)    :: check        ! Verbose flag
  logical,         intent(inout) :: error        ! Error flag
  ! Local
  character(len=*), parameter :: rname='FITS'
  character(len=11) :: line1,line6
  character(len=10) :: line2,line3,line4,line5
  real(kind=8) :: val,inc,ref,rota
  character(len=80) :: line
  character(len=12) :: code, unit
  logical :: projected
  integer(kind=4) :: l
  logical, parameter :: export_radio_as_sfl=.true.
  !
  write(line1,101) axis_number
  write(line2,102) axis_number
  write(line3,103) axis_number
  write(line4,104) axis_number
  write(line5,105) axis_number
  write(line6,106) axis_number
  !
101 format ('CTYPE',i1,'  = ''')
102 format ('CRVAL',i1,'  = ')
103 format ('CDELT',i1,'  = ')
104 format ('CRPIX',i1,'  = ')
105 format ('CROTA',i1,'  = ')
106 format ('CUNIT',i1,'  = ''')
  !
  if (fits%gil%ptyp.ne.p_none) then
    projected = (axis_number.eq.fits%gil%xaxi .or. axis_number.eq.fits%gil%yaxi)
  else
    projected = .false.
  endif
  !
  ! Recognised codes should be
  !       RA      DEC
  !       L       B       or      GLAT    GLON
  !       FREQUENCY
  !       VELOCITY
  !
  ref = fits%gil%ref(axis_number)
  val = fits%gil%val(axis_number)
  inc = fits%gil%inc(axis_number)
  code = fits%char%code(axis_number)
  rota = 0.d0
  !
  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 = lenc(code)+1
    code(l:8) = '------------'
    if (fits%gil%ptyp.eq.p_gnomonic) then
      code(6:8) = 'TAN'
    elseif (fits%gil%ptyp.eq.p_ortho) then
      code(6:8) = 'SIN'
    elseif (fits%gil%ptyp.eq.p_azimuthal) then
      code(6:8) = 'ARC'
    elseif (fits%gil%ptyp.eq.p_stereo) then
      code(6:8) = 'STG'
    elseif (fits%gil%ptyp.eq.p_aitoff) then
      code(6:8) = 'AIT'
    elseif (fits%gil%ptyp.eq.p_sfl) then
      code(6:8) = 'SFL'
    elseif (fits%gil%ptyp.eq.p_radio) then
      ! See related IRAM Memo
      if (export_radio_as_sfl) then
        code(6:8) = 'SFL'
      else
        code(6:8) = 'GLS'
      endif
    else
      code(6:8) = '   '
    endif
    !
    ! Compute reference pixel so that VAL(REF) = 0
    ref = ref - val/inc
    if (fits%gil%xaxi.eq.axis_number) then  ! X axis
      val = fits%gil%a0
    else  ! Y axis
      if (fits%gil%ptyp.eq.p_radio .and. export_radio_as_sfl) then
        ! GLS is the same as SFL projection with reference declination
        ! 0 and appropriate shift of the reference pixel
        call gio_message(seve%w,rname,'Projection kind converted from radio to SFL')
        ref = ref-fits%gil%d0/inc
        val = 0.d0
      elseif (fits%gil%ptyp.eq.p_aitoff) then
        ! Because GILDAS support for Aitoff projection implements equations
        ! ignoring the d0 reference value (i.e. it is forced on the Equator).
        val = 0.d0
      else
        val = fits%gil%d0
      endif
    endif
    val = val*180.d0/pi
    inc = inc*180.d0/pi
    rota = 180.d0/pi*fits%gil%pang
    unit = '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*180.d0/pi
    inc = inc*180.d0/pi
  elseif (code.eq.'FREQUENCY') then
    val = val*1.0d6            ! MHz to Hz
    inc = inc*1.0d6
    unit = '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
    unit = 'm/s'
  else
    l = lenc(code)+1
    code(l:12) = '            '    ! fills with blanks code.
    unit = ' '
  endif
  !
  call gfits_put(line1//code//'''               /',check,error)
  if (error) goto 99
  write (line,20) line2,val
  call gfits_put(line,check,error)
  if (error) goto 99
  if (inc.eq.0.0d0) inc = 1.0d0
  write (line,20) line3,inc
  call gfits_put(line,check,error)
  if (error) goto 99
  write (line,20) line4,ref
  call gfits_put(line,check,error)
  if (error) goto 99
  write (line,20) line5,rota
  call gfits_put(line,check,error)
  if (error) goto 99
  call gfits_put(line6//unit//'''               /',check,error)
  return
99 return
20 format(a,e20.13,'         / ',a)
end subroutine write_axis
