subroutine gdf_print_header(img)
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>gdf_print_header
  use image_def
  use gbl_format
  use gbl_constant
  use phys_const
  use gio_uv
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! GIO Library
  !       Support routine for command HEADER
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: img  ! Header to be printed
  ! Local
  character(len=*), parameter :: rname='PRTHEADER'
  real, parameter :: sec=180.*3600./acos(-1.0)
  !
  integer mstoke !!!!
  integer, parameter :: mform=9
  character(len=9) :: form(mform)
  character(len=15) :: chde,chra,cha0,chd0
  real :: fm,fp,ff
  integer :: i,ll,n
  integer, parameter :: mline=32, mcol=80
  integer :: kline, ksour, vtyp, ilead
  character(len=79) :: cline(mline), clead
  character(len=12) :: code(gdf_maxdims)
  character(len=54) :: fich
  character(len=16) :: prefix
  logical :: error, ok
  character(len=12), save :: vtype(0:4)
  data vtype /'Unknown', 'LSR', 'Heliocentric', 'Observatory', 'Earth'/
  integer :: k
  data form/'REAL*4','REAL*8','INTEGER*4','LOGICAL','INTEGER*2','BYTE',  &
            'COMPLEX*4','COMPLEX*8','INTEGER*8'/
  !
  call gio_message(seve%t,rname,'Entering...')
  !
  !
  if (abs(img%gil%type_gdf).eq.code_gdf_uvt) then
    prefix = 'UV Table : '
  else if (img%gil%type_gdf.eq.code_gdf_image) then
    prefix = 'DATA Cube : '
  else if (img%gil%type_gdf.eq.code_gdf_table) then
    prefix = 'Simple Table :'
  else if (img%gil%type_gdf.eq.code_gdf_vo) then
    prefix = 'VO Table'
  else
    prefix = 'Unknown : '
  endif
  !
  cline = ' '
  error = .false.
  !
  ! General
  ll = len_trim(img%file)
  if (ll.eq.0) then
    fich = '  (in memory)  '
  elseif (ll.gt.54) then
    fich = img%file(1:20)//'...'//img%file(ll-34:ll)
  else
    fich = img%file(1:ll)
  endif
  write (cline(1),101) prefix,fich,form(hardware-img%gil%form)
101 format (A,A,T70,A)
  !
  kline = 2
  cline(kline) = 'Size        Reference Pixel           Value'//  &
             '                  Increment'
  do i=1,img%gil%ndim
    kline = kline+1
    write(cline(kline),100) img%gil%dim(i), img%gil%convert(1,i), img%gil%convert(2,i), img%gil%convert(3,i)
  enddo
100 format(i10,1x,1pg22.15,1x,1pg22.15,1x,1pg22.15)
  !
  ! Blanking
  kline = kline+1
  if (img%gil%blan_words.ne.0) then
    write(cline(kline),200) img%gil%bval, img%gil%eval
  else
    write(cline(kline),200) 0.e0,-1.e0
  endif
200 format('Blanking value and tolerance',5x,1pg15.8,1x,1pg15.8)
  ksour = kline+1
  kline = kline+2
  !
  ! Description
  if (img%gil%desc_words.ne.0) then
    cline(kline) = 'Map unit'
    cline(kline)(21:) = img%char%unit
    kline = kline+1
    cline(kline) = 'Axis type'
    code = ' '
    do i=1,img%gil%ndim
      if (len_trim(img%char%code(i)).ne.0) then
        code(i) = img%char%code(i)
      else
        code(i) = 'Unknown'
      endif
    enddo
    cline(kline)(21:) = code(1)//' '//code(2)//' '//  &
                     code(3)//' '//code(4)
    if (img%gil%ndim.gt.4) then
      kline = kline+1
      cline(kline)(21:) = code(5)//' '//code(6)//' '//  &
                     code(7)
    endif
    kline = kline+1
    cline(kline) = 'Coordinate system                       Velocity'
    cline(kline)(21:32) = img%char%syst
  else
    cline(kline) = 'Map unit'
    cline(kline)(21:) = 'Unknown      '
    kline = kline+1
    cline(kline) = 'Axis type'
    cline(kline)(21:) = 'Unknown      Unknown      Unknown      Unknown      '
    kline = kline+1
    cline(kline) = 'Coordinate system                       Velocity'
    cline(kline)(21:32) = 'Unknown      '
  endif
  vtyp = img%gil%vtyp
  if (vtyp.lt.0 .or. vtyp.gt.4) vtyp = 0
  cline(kline)(21+32:) = vtype(vtyp)
  !
  ! Position
  kline = kline+1
  cline(ksour)= 'Source name'
  cline(kline)= 'Right Ascension                         Declination'
  cline(kline+1)= 'Lii                                     Bii'
  cline(kline+2)= 'Equinox'
  if (img%gil%posi_words.ne.0) then
    cline(ksour)(21:32) = img%char%name
    ! Note that source coordinates in the alternate system are not
    ! recomputed. Header content is displayed "as is".
    call rad2sexa (img%gil%ra,24,chra)
    call rad2sexa (img%gil%dec,360,chde)
    cline(kline)(18:32) = chra     ! For 15 char
    cline(kline)(57:71) = chde     ! 
    kline = kline+1
    write(cline(kline)(10:32),'(1PG23.16)') img%gil%lii*180.d0/pi
    write(cline(kline)(49:71),'(1PG23.16)') img%gil%bii*180.d0/pi
    if (img%char%syst.eq.'EQUATORIAL') then
      ! Equinox is displayed only when relevant (i.e. EQUATORIAL system)
      kline = kline+1
      if (img%gil%epoc.eq.equinox_null) then
        write(cline(kline)(21:32),'(A)') 'Unknown'
      else
        write(cline(kline)(18:32),'(1PG15.8)') img%gil%epoc
      endif
    else if (img%char%syst.eq.'ICRS') then
      kline = kline+1
      cline(kline)= 'Epoch: '
      write(cline(kline)(18:32),'(1PG15.8)') img%gil%epoc
    endif
  endif
  !
  ! Projection
  kline = kline+1
  cline(kline) = 'Projection type                         Angle'
  cline(kline+1) = 'Axis       A0                           Axis       D0'
  if (img%gil%proj_words.ne.0) then
    if (img%char%syst.eq.'GALACTIC') then
      cline(kline)(21:32) = projnam(img%gil%ptyp)
      write(cline(kline)(49:71),'(1PG23.16)') img%gil%pang*180d0/pi
      write (chra,'(1PG13.7)')  img%gil%a0 * 180.0d0 /pi
      write (chde,'(1PG13.7)')  img%gil%d0 * 180.0d0 /pi
    else  ! EQUATORIAL or ICRS
      cline(kline)(21:32) = projnam(img%gil%ptyp)
      write(cline(kline)(49:71),'(1PG23.16)') img%gil%pang*180d0/pi
      call rad2sexa(img%gil%a0,24,chra)
      call rad2sexa(img%gil%d0,360,chde)
    endif
    kline = kline+1
    write(cline(kline)(6:6),'(I1)') img%gil%xaxi
    write(cline(kline)(46:46),'(I1)') img%gil%yaxi
    cline(kline)(18:32) = chra
    cline(kline)(57:71) = chde
  else
    cline(kline)(21:32) = 'Not Defined '
  endif
  !
  ! Extrema
  kline = kline+1
  if (img%gil%type_gdf.eq.code_gdf_uvt.or.img%gil%type_gdf.eq.code_gdf_tuv) then
    cline(kline) = 'Baselines '
    write(cline(kline)(18:),'(F10.1,F10.1)') img%gil%basemin,img%gil%basemax
  else
    if (img%gil%extr_words.ne.0) then
      if (img%gil%ndim.gt.4) then
        cline(kline) = 'Minimum'
        write(cline(kline)(18:),300) img%gil%rmin,img%gil%minloc(1:4)
        kline = kline+1
        write(cline(kline)(44:),'(i8,i6,i6)') img%gil%minloc(5:img%gil%ndim)
        kline = kline+1
        cline(kline) = 'Maximum'
        write(cline(kline)(18:),300) img%gil%rmax,img%gil%maxloc(1:4)
        kline = kline+1
        write(cline(kline)(44:),'(i8,i6,i6)') img%gil%maxloc(5:img%gil%ndim)
      else
        cline(kline) = 'Minimum'
        write(cline(kline)(18:),300) img%gil%rmin,img%gil%minloc(1:img%gil%ndim)
        kline = kline+1
        cline(kline) = 'Maximum'
        write(cline(kline)(18:),300) img%gil%rmax,img%gil%maxloc(1:img%gil%ndim)
      endif
    else
      cline(kline) = 'Minimum'
      kline = kline+1
      cline(kline) = 'Maximum'
    endif
  endif
  !
  ! Spectroscopy
  kline = kline+1
  if (img%gil%spec_words.ne.0) then
    cline(kline)     = 'Axis   Line Name                        Rest Frequency'
    cline(kline+1)   = 'Resolution in Velocity                  in Frequency'
    if (img%gil%fima.ne.0.0) then
      cline(kline+2) = 'Offset in Velocity                      Image Frequency'
    else
      cline(kline+2) = 'Offset in Velocity                      Doppler Velocity'
    endif
    write(cline(kline)(6:6),'(I1)')  img%gil%faxi
    cline(kline)(21:32) = img%char%line
    write(cline(kline)(56:),'(1PG23.16)') img%gil%freq
    kline = kline+1
    write(cline(kline)(25:39),'(1PG15.8)') img%gil%vres
    write(cline(kline)(61:),'(1PG15.8)') img%gil%fres
    kline = kline+1
    write(cline(kline)(25:39),'(1PG15.8)') img%gil%voff
    if (img%gil%fima.ne.0.0) then
      write(cline(kline)(56:),'(1PG23.16)') img%gil%fima
    else
      write(cline(kline)(61:),'(1PG15.8)') img%gil%dopp*clight_kms
    endif
  else
    cline(kline) = 'NO Spectroscopic information'
  endif
  !
  ! Resolution
  kline = kline+1
  if (img%gil%reso_words.ne.0) then
    cline(kline) = 'Beam '
    write(cline(kline)(20:31),'(1PG12.3)') img%gil%majo*3600*180/pi
    write(cline(kline)(40:51),'(1PG12.3)') img%gil%mino*3600*180/pi
    write(cline(kline)(61:69),'(F8.2)') img%gil%posa*180/pi
  else
    cline(kline) = 'NO Beam information'
  endif
  !
  ! Noise
  kline = kline+1
  if (img%gil%nois_words.ne.0) then
    cline(kline) = 'Noise '
    write(cline(kline)(25:39),'(1PG15.8)') img%gil%noise
    write(cline(kline)(56:),'(1PG15.8)') img%gil%rms
  else
    cline(kline) = 'NO Noise level'
  endif
  !
  ! Proper Motion
  kline = kline+1
  if (img%gil%astr_words.ne.0) then
    cline(kline) = 'Proper motion'
    cline(kline)(40:48) = 'Parallax'
    write(cline(kline)(20:28),'(F8.2)') img%gil%mura
    write(cline(kline)(30:38),'(F8.2)') img%gil%mudec
    write(cline(kline)(50:58),'(F8.2)') img%gil%parallax
    !!         WRITE(CLINE(25)(40:48),'(F8.2)') IMG%gil%PEPOCH
  else
    cline(kline) = 'NO Proper motion'
  endif
  !
  ! Observatory, starting from Version V2.2 (SYST)
  if (code_version_uvt_current.ge.code_version_uvt_syst) then
    kline = kline+1
    if (img%gil%tele_words.ne.0) then
      if (img%gil%nteles.gt.0) then
        do k=1,img%gil%nteles
          call gwcs_print_telescope(img%gil%teles(k),cline(kline))
          kline = kline+1
        enddo
        kline = kline-1
      else
        cline(kline) = 'NO Telescope in section'
      endif
    else
      cline(kline) = 'NO Telescope section'
    endif
  endif
  !
  ! UV Data
  if (img%gil%uvda_words.ne.0) then
    !!Print *,'Doing UVDA_WORDS ',img%gil%uvda_words
    kline = kline+1
    cline(kline) = 'UV Data'
    cline(kline)(12:20) = 'Channels:'
    write(cline(kline)(21:27),'(I7)') img%gil%nchan
    cline(kline)(28:36) = ', Stokes:'
    write(cline(kline)(37:38),'(I2)') img%gil%nstokes
    n = 40
    if (abs(img%gil%order).eq.abs(code_stok_chan)) then
      !!Print *,'Found code_stok_chan ',img%gil%nstokes
      do i=1,img%gil%nstokes
        cline(kline)(n:) = gdf_stokes_name(img%gil%stokes(i))
        n = n+3
      enddo
    else
      cline(kline)(n:) = gdf_stokes_name(img%gil%order)
    endif
    cline(kline)(52:64) = 'Visibilities:'
    write(cline(kline)(65:76),'(I12)') img%gil%nvisi
    !
  endif
  !
  do i=1,kline
    write(6,'(A)') trim(cline(i))
  enddo
  !
  ! Here print the UV data layout
  if (img%gil%uvda_words.ne.0) then
    ! 
    ! The Leading columns first
    write(6,'(A)') "Column names, pointers & size"
    do k=1,2
      ilead = 1
      clead = ' '
      do i=1,code_uvt_last
        if (img%gil%column_pointer(i).ne.0) then
          ok = .false.
          if ((k.eq.1).and.(img%gil%column_pointer(i).le.img%gil%nlead)) ok = .true.
          if ((k.eq.2).and.(img%gil%column_pointer(i).gt.img%gil%nlead)) ok = .true. 
          if (ok) then
            write(clead(ilead:),'(A,1X,I6,I2)') uv_column_name(i),img%gil%column_pointer(i),& 
            & img%gil%column_size(i)
            ilead = len_trim(clead)+2
            if (ilead.gt.60) then
              write(6,'(A)') clead(1:ilead)
              clead = ' '
              ilead = 1
            endif
          endif
        endif
      enddo
      if (ilead.gt.2) write(6,'(A)') clead(1:ilead)
    enddo
  endif
  !
  ! The Stokes and Frequency layout
  if (img%gil%nfreq.ne.0) then
    ! This assumes the Stokes first, Channel next layout...
    if (associated(img%gil%stokes)) then    
      mstoke = ubound(img%gil%stokes,1)
    else
      mstoke = 0
    endif
    !
    ! Printout assumes there are as many Stokes information as Frequency information,
    ! or no Stokes information at all.
    Print *,'Nfreq ',img%gil%nfreq,' Nstokes ',img%gil%nstokes,mstoke !!Under TEST
    write(*,*) img%gil%order,' Channel  Stokes  Frequency '
    do i=1,img%gil%nfreq
      if (mstoke.eq.0) then
        write(*,*) i, 0, "NONE", img%gil%freqs(i)      
      else
        !!k = mod(i-1,img%gil%nstokes)+1
        !!Print *,'K ',k,i
        write(*,*) i, img%gil%stokes(i), gdf_stokes_name(img%gil%stokes(i)), img%gil%freqs(i)
      endif
    enddo
  endif
  !
  if (img%mos%nfields.ne.0) then
    write(*,'(A,I0,A)') 'Mosaic of ',img%mos%nfields,' pointings'
    if (img%gil%nteles.gt.1) then
      write(6,'(A)') "Field     Ra               Dec            A0               D0           Nvisi Tel#"
    else
      write(6,'(A)') "Field     Ra               Dec            A0               D0           Nvisi"
    endif
    do i=1,img%mos%nfields
      call rad2sexa (img%mos%fields(i)%apoint(1),24,chra)
      call rad2sexa (img%mos%fields(i)%apoint(2),360,chde)
      call rad2sexa (img%mos%fields(i)%aphase(1),24,cha0)
      call rad2sexa (img%mos%fields(i)%aphase(2),360,chd0)
      if (img%gil%nteles.gt.1) then
        write(6,'(I4,4(1X,A),I9,I3)') i,chra,chde,cha0,chd0,img%mos%fields(i)%nvisi,img%mos%fields(i)%jteles
      else
        write(6,'(I4,4(1X,A),I9,I3)') i,chra,chde,cha0,chd0,img%mos%fields(i)%nvisi
      endif
    enddo
    !
    write(6,'(A)') "Field     dRa     dDec     dA0      dD0    DeltaX   DeltaY    Jx    Jy  Noise"
    !
    ! Adapt Field offset format to the range of Position offsets
    fm = 0
    fp = 0
    do i=1,img%mos%nfields
      ff = maxval(abs(img%mos%fields(i)%opoint))
      fm = max(fm,ff)
      ff = maxval(abs(img%mos%fields(i)%ophase))
      fp = max(fp,ff)
    enddo
    ff = max(fm,fp)*sec
    if (ff.gt.1) then
      do i=1,img%mos%nfields
        write(6,'(I4,4(1X,F8.2),2(1X,F8.2),2(1X,I5),1X,1PG10.3)') i, & 
          & img%mos%fields(i)%opoint(1)*sec, img%mos%fields(i)%opoint(2)*sec, & 
          & img%mos%fields(i)%ophase(1)*sec, img%mos%fields(i)%ophase(2)*sec, & 
          & img%mos%fields(i)%oxy(1)*sec, img%mos%fields(i)%oxy(2)*sec, & 
          & img%mos%fields(i)%jxy(1), img%mos%fields(i)%jxy(2), img%mos%fields(i)%sigma
      enddo
    else
      do i=1,img%mos%nfields
        write(6,'(I4,4(1X,F8.4),2(1X,F8.4),2(1X,I5),1X,1PG10.3)') i, & 
          & img%mos%fields(i)%opoint(1)*sec, img%mos%fields(i)%opoint(2)*sec, & 
          & img%mos%fields(i)%ophase(1)*sec, img%mos%fields(i)%ophase(2)*sec, & 
          & img%mos%fields(i)%oxy(1)*sec, img%mos%fields(i)%oxy(2)*sec, & 
          & img%mos%fields(i)%jxy(1), img%mos%fields(i)%jxy(2), img%mos%fields(i)%sigma
      enddo
    endif
  endif
  !
  call gio_message(seve%t,rname,'Leaving !..')
  !
300 format(1pg15.8,'  at ',i8,i8,i6,i6)
end subroutine gdf_print_header
!
subroutine gio_dump_header (imag)
  use image_def
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type (gildas), intent(in) :: imag                !
  integer i
  !
  ! Debugging routine: dump an image header, without messages "a la SIC" so far
  !
  write(6,100) imag%char%type,' IMAG%gil%ityp'
  write(6,*) imag%gil%form,' IMAG%gil%form'
  write(6,*) imag%gil%ndb,' IMAG%gil%ndb'
  !!write(6,*) imag%gil%fill,' IMAG%gil%fill'
!V! write(6,*) imag%gil%gene,' IMAG%gil%gene'
  write(6,*) imag%gil%ndim,' IMAG%gil%ndim'
  write(6,*) imag%gil%dim,' IMAG%gil%dim'
  write(6,*) imag%gil%convert,' IMAG%gil%  Convert'
  write(6,*) imag%gil%blan_words,' IMAG%gil%blan_words'
  write(6,*) imag%gil%bval, imag%gil%eval,' IMAG%gil%blank'
!
  write(6,*) imag%gil%extr_words,' IMAG%gil%extr_words'
  write(6,*) imag%gil%rmin,' IMAG%gil%min'
  write(6,*) imag%gil%rmax,' IMAG%gil%max'
  write(6,*) imag%gil%minloc,' IMAG%gil%minloc'
  write(6,*) imag%gil%maxloc, 'IMAG%gil%maxloc'
  !
  write(6,*) imag%gil%desc_words,' IMAG%gil%desc_words'
  write(6,100) imag%char%unit,' IMAG%gil%iuni'
  write(6,101) imag%char%code,' IMAG%gil%icod'
  write(6,100) imag%char%syst,' IMAG%gil%isys'

  write(6,*) imag%gil%posi_words,' IMAG%gil%posi_words'
  write(6,100) imag%char%name,' IMAG%gil%isou'
  write(6,*) imag%gil%ra,' IMAG%gil%ra'
  write(6,*) imag%gil%dec,' IMAG%gil%dec'
  write(6,*) imag%gil%lii,' IMAG%gil%lii'
  write(6,*) imag%gil%bii,' IMAG%gil%bii'
  write(6,*) imag%gil%epoc,' IMAG%gil%epoc'
!
  write(6,*) imag%gil%proj_words,' IMAG%gil%proj_words'
  write(6,*) imag%gil%ptyp,' IMAG%gil%ptyp'
  write(6,*) imag%gil%a0,' IMAG%gil%a0'
  write(6,*) imag%gil%d0,' IMAG%gil%d0'
  write(6,*) imag%gil%pang,' IMAG%gil%angle'
  write(6,*) imag%gil%xaxi,' IMAG%gil%x_axis'
  write(6,*) imag%gil%yaxi,' IMAG%gil%y_axis'
!
  write(6,*) imag%gil%spec_words,' IMAG%gil%spec_words'
  write(6,100) imag%char%line,' IMAG%gil%ilin'
  write(6,*) imag%gil%fres,' IMAG%gil%freqres'
  write(6,*) imag%gil%fima,' IMAG%gil%imagfre'
  write(6,*) imag%gil%freq,' IMAG%gil%restfre'
  write(6,*) imag%gil%vres,' IMAG%gil%velres'
  write(6,*) imag%gil%voff,' IMAG%gil%veloff'
  write(6,*) imag%gil%faxi,' IMAG%gil%f_axis'
!
  write(6,*) imag%gil%reso_words,' IMAG%gil%reso_words'
  write(6,*) imag%gil%majo,' IMAG%gil%major'
  write(6,*) imag%gil%mino,' IMAG%gil%minor'
  write(6,*) imag%gil%posa,' IMAG%gil%pa'
!
  print *,imag%gil%nois_words, ' IMAG%gil%nois_words'
  print *,imag%gil%noise, ' IMAG%gil%noise'
  print *,imag%gil%rms, ' IMAG%gil%rms'
!
  print *,imag%gil%astr_words, ' IMAG%gil%astr_words'
  print *,imag%gil%mura, ' IMAG%gil%mura'
  print *,imag%gil%mudec, ' IMAG%gil%mudec'
  print *,imag%gil%parallax, ' IMAG%gil%parallax'
!
  print *,imag%gil%uvda_words, ' IMAG%gil%uvda_words'
  print *,imag%gil%nchan, ' IMAG%gil%nchan'
  print *,imag%gil%nstokes, ' IMAG%gil%nstokes'
  print *,imag%gil%nvisi, ' IMAG%gil%nvisi'
!
  do i=1,code_uvt_last
    if (imag%gil%column_pointer(i).ne.0) then
      Print *,'Column ',imag%gil%column_pointer(i),', Size ',imag%gil%column_size(i)!
      !! ' contains ',items(i)
    endif
  enddo
  !
  print *,imag%gil%tele_words, ' IMAG%gil%tele_words'
  print *,imag%gil%nteles, ' IMAG%gil%nteles'
!  print *,imag%char%tele, ' IMAG%gil%teles(1)%ctele'
!
100 format(1x,a,1x,a)
101 format(1x,4(a,1x),a)
end subroutine gio_dump_header
!
subroutine gdf_addteles(fits,key,name,value,error)
  use image_def
  use gbl_message
  use gio_dependencies_interfaces
  use gio_interfaces, except=>gdf_addteles
  !---------------------------------------------------------------
  ! @ public
  ! GDF
  !   Add a new telescope
  !---------------------------------------------------------------
  type(gildas),     intent(inout) :: fits      ! Output GILDAS structure
  character(len=*), intent(in)    :: key       ! Operation Key
  character(len=*), intent(in)    :: name      ! Telescope name
  real(kind=8),     intent(in)    :: value(3)  ! Input values
  logical,          intent(inout) :: error     !
  ! Local
  character(len=*), parameter :: rname='ADDTELES'
  character(len=message_length) :: mess
  character(len=12) :: cname  ! Telescope name
  integer(kind=4) :: itel,ier
  !
  if (fits%gil%nteles.eq.0) then
    ! Print *,'No previous telescope defined, adding one...'
    ! No telescope defined
    fits%gil%nteles = 1
    allocate(fits%gil%teles(1),stat=ier)
  else if (.not.allocated(fits%gil%teles)) then
    ! Number of telescope set, but nothing already done
    fits%gil%nteles = 1
    allocate(fits%gil%teles(fits%gil%nteles),stat=ier)
  endif
  !
  select case (key)
  case('TELE')
    ! Patch for some files created at IRAM...
    if (len(name).ge.4 .and. name(1:4).eq.'IRAM') then
      if (name(6:8).eq.'PDB') then
        cname ='PDBI'
      elseif (name(5:5).eq.'-') then
        cname = name(6:)  ! e.g. "IRAM-30M"
      else
        cname = name(5:)  ! e.g. "IRAM30M"
      endif
    else
      cname = name
    endif
    if (fits%gil%teles(fits%gil%nteles)%ctele.ne.' ') then
      ! The latest slot is not free. Need to add one, except
      ! if this telescope is already in the list (else skip this
      ! addition)
      do itel=1,fits%gil%nteles
        if (fits%gil%teles(itel)%ctele.eq.cname) then
          ! call gio_message(seve%w,rname,'Telescope '//trim(cname)//  &
          !   ' is already in the telescope section, skipping')
          return
        endif
      enddo
      call enlarge_section(fits,error)
      if (error)  return
    endif
    call gwcs_observatory(cname,fits%gil%teles(fits%gil%nteles),error)
    if (error) then
      fits%gil%nteles = fits%gil%nteles-1  ! Forgive slot which was added
      ! Section length unchanged, can leave now
      return
    endif
    call gwcs_print_telescope(fits%gil%teles(fits%gil%nteles),mess)
    call gio_message(seve%i,rname,mess)
    !
  case('NAME')
    if (fits%gil%teles(fits%gil%nteles)%ctele.ne.' ') then
      call enlarge_section(fits,error)
      if (error)  return
    endif
    fits%gil%teles(fits%gil%nteles)%ctele = name
    !
  case('GEO')
    if (fits%gil%teles(fits%gil%nteles)%alt.lt.-1000.) then
      call enlarge_section(fits,error)
      if (error)  return
    endif
    fits%gil%teles(fits%gil%nteles)%lon = value(1)
    fits%gil%teles(fits%gil%nteles)%lat = value(2)
    fits%gil%teles(fits%gil%nteles)%alt = value(3)
    !
  case('DIAM')
    if (fits%gil%teles(fits%gil%nteles)%diam.eq.0.) then
      call enlarge_section(fits,error)
      if (error)  return
    endif
    fits%gil%teles(fits%gil%nteles)%diam = value(1)
    !
  end select
  !
  fits%gil%tele_words = 2+fits%gil%nteles*10
  !!Print *,'UVFITS Tele_Words ',fits%gil%tele_words
  !
contains
  !
  subroutine enlarge_section(x,error)
    !-------------------------------------------------------------------
    ! Add one more telescope to the existing list
    !-------------------------------------------------------------------
    type(gildas), intent(inout) :: x
    logical,      intent(inout) :: error
    ! Local
    type(telesco), allocatable :: tmp(:)
    !
    allocate(tmp(x%gil%nteles),stat=ier)
    if (failed_allocate(rname,'teles buffer',ier,error))  return
    tmp(:) = x%gil%teles(1:x%gil%nteles)
    deallocate(x%gil%teles)
    !
    x%gil%nteles = x%gil%nteles+1
    allocate(x%gil%teles(x%gil%nteles),stat=ier)
    if (failed_allocate(rname,'teles buffer',ier,error))  return
    x%gil%teles(1:x%gil%nteles-1) = tmp(:)
  end subroutine enlarge_section
  !
end subroutine gdf_addteles
!
subroutine gdf_rmteles(fits,name,error)
  use image_def
  use gbl_message
  use gio_dependencies_interfaces
  use gio_interfaces, except=>gdf_rmteles
  !---------------------------------------------------------------
  ! @ public
  !  Remove a telescope from section, identified by its name
  !---------------------------------------------------------------
  type(gildas),     intent(inout) :: fits      ! Output GILDAS structure
  character(len=*), intent(in)    :: name      ! Telescope name
  logical,          intent(inout) :: error     !
  ! Local
  character(len=*), parameter :: rname='RMTELES'
  character(len=12) :: cname  ! Telescope name
  integer(kind=4) :: itel,ier
  !
  if (fits%gil%nteles.eq.0) then
    ! No telescope defined => nothing to do
    return
  else if (.not.allocated(fits%gil%teles)) then
    ! Number of telescope set, but nothing defined yet => nothing to do
    return
  endif
  !
  ! Patch for some files created at IRAM...
  if (len(name).ge.4 .and. name(1:4).eq.'IRAM') then
    if (name(6:8).eq.'PDB') then
      cname ='PDBI'
    elseif (name(5:5).eq.'-') then
      cname = name(6:)  ! e.g. "IRAM-30M"
    else
      cname = name(5:)  ! e.g. "IRAM30M"
    endif
  else
    cname = name
  endif
  !
  itel = 1
  do while (itel.le.fits%gil%nteles)
    if (fits%gil%teles(itel)%ctele.eq.cname) then
      call gio_message(seve%i,rname,'Removing telescope '//cname)
      ! Decrease fits%gil%nteles
      call reduce_section(fits,itel,error)
      if (error)  return
    else
      ! Increase itel
      itel = itel+1
    endif
  enddo
  !
  if (fits%gil%nteles.gt.0) then
    fits%gil%tele_words = 2+fits%gil%nteles*10
  else
    fits%gil%tele_words = 0
  endif
  !!Print *,'UVFITS Tele_Words ',fits%gil%tele_words
  !
contains
  !
  subroutine reduce_section(x,jtel,error)
    !-------------------------------------------------------------------
    ! Remove one telescope from the existing list
    !-------------------------------------------------------------------
    type(gildas),    intent(inout) :: x
    integer(kind=4), intent(in)    :: jtel
    logical,         intent(inout) :: error
    ! Local
    type(telesco), allocatable :: tmp(:)
    !
    if (jtel.lt.1 .or. jtel.gt.x%gil%nteles) then
      print *,"Internal error: invalid telescope number ",jtel
      error = .true.
      return
    endif
    !
    if (x%gil%nteles.eq.1) then
      ! jtel must be 1 from above check
      deallocate(x%gil%teles)
    else
      allocate(tmp(x%gil%nteles),stat=ier)
      if (failed_allocate(rname,'teles buffer',ier,error))  return
      tmp(:) = x%gil%teles(1:x%gil%nteles)
      !
      deallocate(x%gil%teles)
      allocate(x%gil%teles(x%gil%nteles-1),stat=ier)
      if (failed_allocate(rname,'teles buffer',ier,error))  return
      if (jtel.gt.1)             x%gil%teles(1:jtel-1) = tmp(1:jtel-1)
      if (jtel.lt.x%gil%nteles)  x%gil%teles(jtel:x%gil%nteles-1) = tmp(jtel+1:x%gil%nteles)
    endif
    !
    x%gil%nteles = x%gil%nteles-1
  end subroutine reduce_section
  !
end subroutine gdf_rmteles
