subroutine uv_fields_comm(line,comm,error)
  use gildas_def
  use image_def
  use gkernel_types
  use gbl_message
  use clean_arrays
  !
  use gkernel_interfaces
  use imager_interfaces, except_this => uv_fields_comm
  use iso_c_binding
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGE
  !   Support command for @ fits_to_uvt.ima,
  !   the UVFITS to UV Table conversion script.
  !
  !   UV_FIELDS RaVar DecVar [Unit] [/FILE FileIn FileOut]
  !       [/CENTER Ra Dec]
  !
  !     Replace fields ID by Fields offsets.
  !
  ! For files imported from UVFITS, the Fields offsets are found in 
  !   the AIPS SU Table which is not decoded by the FITS command, 
  !   but only through the DEFINE FITS command.
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  character(len=*), intent(in) :: comm
  logical, intent(out) :: error
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  real(4), parameter :: rad_to_sec=180.*3600./pi
  integer, parameter :: o_center=1
  integer, parameter :: o_file=2
  character(len=*), parameter :: rname='UV_FIELDS'
  !
  character(len=filename_length) :: uvdata
  character(len=64) :: coff_x, coff_y
  character(len=16) :: chain
  integer :: nf, ier, i, n
  real(kind=8), allocatable :: raoff(:), deoff(:), rapos(:), depos(:)
  real(kind=8), allocatable :: offs(:,:)
  real(kind=4), allocatable :: tmp(:)
  logical :: found
  type(sic_descriptor_t) :: desc_x,desc_y
  !
  type(gildas) :: huvin
  real(kind=8) :: px, py
  character(len=32) :: cx, cy
  character(len=20) :: c20
  character(len=80) :: c80
  integer :: next
  type(projection_t) :: uv_proj
  type(c_ptr) :: cptr
  real(4), pointer :: r1ptr(:)
  real(8), pointer :: d1ptr(:)
  integer(kind=address_length) :: addrx, addry
  !
  ! Code:
  error = .false.
  !
  call sic_ch(line,0,1,coff_x,n,.true.,error)
  if (error) return
  call sic_descriptor(coff_x,desc_x,found)  
  if (.not.found) then
    call map_message(seve%e,rname,'X pointing variable '//trim(coff_x)//' does not exist')
    error = .true.
    return
  endif
  !
  call sic_ch(line,0,2,coff_y,n,.true.,error)
  if (error) return
  call sic_descriptor(coff_y,desc_y,found)  
  if (.not.found) then
    call map_message(seve%e,rname,'Y pointing variable '//trim(coff_y)//' does not exist')
    error = .true.
    return
  endif
  !
  ! Unit is either ABS or Angle Unit (R, D, M, S) - Not fully coded yet...
  if (desc_x%type.gt.0) then
    if (desc_y%type.gt.0) then
      chain = 'ABS'
    else
      call map_message(seve%e,rname,'Invalid mixture of X and Y pointing variable types')
      error = .true.
      return
    endif
  else
    chain = 'RAD'
  endif
  call sic_ke(line,0,3,chain,n,.false.,error)
  chain = chain(1:3)
  !
  if (any(desc_x%dims.ne.desc_y%dims)) then
    call map_message(seve%e,rname,'Pointing variables '//trim(coff_x)// &
      & ' and '// trim(coff_y)//' do not match')
    error = .true.
  else if (desc_x%ndim.ne.1) then
    call map_message(seve%e,rname,'Pointing variables '//trim(coff_x)// &
      & ' and '// trim(coff_y)//' must be of Rank 1')
    error = .true.
  endif
  if (error) return
  !
  nf = desc_x%dims(1)
  !
  allocate (raoff(nf),deoff(nf),offs(2,nf),rapos(nf),depos(nf),tmp(nf),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  !
  ! We must read the HEADER for the /FILE stuff, in case there is an angle...
  call gildas_null (huvin, type = 'UVT')     ! Define a UVTable gildas header
  if (sic_present(o_file,0)) then
    call sic_ch(line,o_file,1,uvdata,n,.true.,error)
    if (error) return
    !
    call gdf_read_gildas (huvin, uvdata, '.uvt', error, data=.false.)
    if (error) then
      call map_message(seve%e,rname,'Cannot read input UV header')
      return
    endif
  else
    call gdf_copy_header(huv,huvin,error)
  endif
  !
  ! OK, get the Fields coordinates from the Variable Descriptors
  if (.not.sic_present(o_center,0)) then
    !
    ! no /CENTER option: these are offsets, as specified by user
    call adtoad(desc_x%addr,cptr,1)
    if (desc_x%type.eq.fmt_r4) then
      call c_f_pointer(cptr,r1ptr,[nf])
      raoff(:) = r1ptr
    else if (desc_x%type.eq.fmt_r8) then
      call c_f_pointer(cptr,d1ptr,[nf])
      raoff(:) = d1ptr
    else
      call map_message(seve%e,rname,'Offset Pointing variables must be Real or Double')
      error = .true.
      return
    endif
    !
    call adtoad(desc_y%addr,cptr,1)
    if (desc_x%type.eq.fmt_r4) then
      call c_f_pointer(cptr,r1ptr,[nf])
      deoff(:) = r1ptr
    else if (desc_x%type.eq.fmt_r8) then
      call c_f_pointer(cptr,d1ptr,[nf])
      deoff(:) = d1ptr
    else
      call map_message(seve%e,rname,'Offset Pointing variables must be Real or Double')
      error = .true.
      return
    endif
    !
    ! Scale with appropriate angular unit.
    select case (chain)
    case ('RAD')
      offs(1,:) = raoff
      offs(2,:) = deoff
    case ('DEG')
      offs(1,:) = raoff*pi/180.d0
      offs(2,:) = deoff*pi/180.d0
    case ('MIN')
      offs(1,:) = raoff*pi/180.d0/60.d0
      offs(2,:) = deoff*pi/180.d0/60.d0
    case ('SEC')
      offs(1,:) = raoff*pi/180.d0/3600.d0
      offs(2,:) = deoff*pi/180.d0/3600.d0
    case default
      call map_message(seve%e,rname,'Unknown offset units '//trim(chain))
      error = .true.
      return
    end select     
  else
    ! /CENTER option
    !   These are absolute coordinates, either as Characters
    !   or with the specified unit. 
    !
    ! The pointing center is specified, but the Angle is inherited
    !   from the UV data.
    !
    call sic_ch(line,o_center,1,cx,n,.true.,error)
    if (error) return
    call gwcs_sexa(cx,px,error)
    if (error) return
    px = px*pi/12.d0
    huvin%gil%a0 = px
    !
    call sic_ch(line,o_center,2,cy,n,.true.,error)
    if (error) return
    call gwcs_sexa(cy,py,error)
    if (error) return
    py = py*pi/180.d0
    huvin%gil%d0 = py
    !
    ! Set the Projection
    call gwcs_projec(huvin%gil%a0,huvin%gil%d0,huvin%gil%pang,huvin%gil%ptyp,uv_proj,error)
    if (error) return
    !
    call map_message(seve%i,rname,'Centering Mosaic on R.A. '//trim(cx)//'   Dec. '//cy)
    !      
    if (desc_x%type.le.0 .or. desc_y%type.le.0) then
      !
      ! no ABSOLUTE keyword: these are centers, in the specified unit.
      call adtoad(desc_x%addr,cptr,1)
      if (desc_x%type.eq.fmt_r4) then
        call c_f_pointer(cptr,r1ptr,[nf])
        rapos(:) = r1ptr
      else if (desc_x%type.eq.fmt_r8) then
        call c_f_pointer(cptr,d1ptr,[nf])
        rapos(:) = d1ptr
      else
        call map_message(seve%e,rname,'Pointing variables must be Real or Double')
        error = .true.
        return
      endif
      !
      call adtoad(desc_y%addr,cptr,1)
      if (desc_y%type.eq.fmt_r4) then
        call c_f_pointer(cptr,r1ptr,[nf])
        depos(:) = r1ptr
      else if (desc_y%type.eq.fmt_r8) then
        call c_f_pointer(cptr,d1ptr,[nf])
        depos(:) = d1ptr
      else
        call map_message(seve%e,rname,'Pointing variables must be Real or Double')
        error = .true.
        return
      endif
      !
      select case (chain)
      case ('RAD')
        continue
      case ('DEG')
        rapos = rapos*pi/180.d0
        depos = depos*pi/180.d0
      case ('MIN')
        rapos = rapos*pi/180.d0/60.d0
        depos = depos*pi/180.d0/60.d0
      case ('SEC')
        rapos = rapos*pi/180.d0/60.d0
        depos = depos*pi/180.d0/60.d0
      case default
        call map_message(seve%e,rname,'Unknown pointing units '//trim(chain))
        error = .true.
        return
      end select     
      !
      ! Convert to Offsets
      call abs_to_rel(uv_proj,rapos,depos,raoff,deoff,nf)
      offs(1,:) = raoff
      offs(2,:) = deoff
    else
      ! Character case
      addrx = desc_x%addr
      addry = desc_y%addr
      do i=1,nf
        call destoc(desc_x%type,addrx,cx)
        addrx = addrx + desc_x%type
        call destoc(desc_y%type,addry,cy)
        addry = addry + desc_y%type
        call gwcs_sexa(cx,px,error)
        px = px*pi/12.d0
        call gwcs_sexa(cy,py,error)
        py = py*pi/180.d0
        !
        call abs_to_rel(uv_proj,px,py,offs(1,i),offs(2,i),1)
      enddo
    endif
    !
    ! List the Offsets
    call map_message(seve%i,rname,'Offsets : ')
    next = 1
    do i=1,nf
      write(c20,'(A,F8.2,A,F8.2,A)') "(",offs(1,i)*rad_to_sec,',',offs(2,i)*rad_to_sec,')'
      c80(next:) = c20
      next = next+20
      if (next.ge.80) then
        write(*,'(A)') c80
        next = 1
      endif
    enddo
    if (next.gt.1) write(*,'(A)') c80(1:next-1)
  endif
  !
  if (sic_present(o_file,0)) then
    !
    call sub_file_fields(huvin,nf,offs,error)
    if (error) return
  else
    call sub_memory_fields(huv,duv,nf,offs,error)
    if (error) return
    if (sic_present(o_center,0)) then
      huv%gil%a0 = huvin%gil%a0
      huv%gil%d0 = huvin%gil%d0
      huv%gil%ra = huvin%gil%a0
      huv%gil%dec = huvin%gil%d0
    endif
  endif
end subroutine uv_fields_comm
!
subroutine sub_file_fields (huvin, nf, offs, error)
  use gkernel_interfaces
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support for @ fits_to_uvt.map
  !     Replace fields ID by Fields offsets
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: huvin    ! Input Header
  integer, intent(in) :: nf                ! Number of fields
  real(kind=8), intent(in) :: offs(2,nf)   ! Offset values
  logical, intent(out) :: error            ! Error flag
  !
  ! Local variables
  character(len=*), parameter :: rname='UV_FIELDS'
  character(len=80)  :: mess
  integer :: ier, nblock, ib, invisi, iv, ixoff, iyoff, isou, icode
  real :: rsou
  !
  ! Update the proper columns
  if (huvin%gil%column_size(code_uvt_id).ne.0) then
    call map_message(seve%i,rname,'Replacing Field numbers by PHASE offsets')
    ixoff = huvin%gil%column_pointer(code_uvt_id)
    iyoff = ixoff+1
    huvin%gil%column_pointer(code_uvt_loff) = ixoff
    huvin%gil%column_pointer(code_uvt_moff) = iyoff
    huvin%gil%column_size(code_uvt_loff) = 1
    huvin%gil%column_size(code_uvt_moff) = 1
    huvin%gil%column_pointer(code_uvt_id) = 0
    huvin%gil%column_size(code_uvt_id) = 0
    icode = 0
  else if (huvin%gil%column_size(code_uvt_loff).ne.0) then
    ixoff =     huvin%gil%column_pointer(code_uvt_loff)
    iyoff =     huvin%gil%column_pointer(code_uvt_moff)
    call map_message(seve%w,rname,'UV Table is already of type PHASE, checking Field numbers')
    icode = 1
  else if (huvin%gil%column_size(code_uvt_xoff).ne.0) then
    ixoff =     huvin%gil%column_pointer(code_uvt_xoff)
    iyoff =     huvin%gil%column_pointer(code_uvt_yoff)
    call map_message(seve%w,rname,'UV Table is already of type POINT, checking Field numbers')
    icode = -1
  else
    call map_message(seve%e,rname,'UV table is not a mosaic')
    error = .true.
    return
  endif
  !
  ! Define blocking factor, on largest data file, usually the input one
  ! but not always...
  call gdf_nitems('SPACE_GILDAS',nblock,huvin%gil%dim(1)) ! Visibilities at once
  nblock = min(nblock,huvin%gil%dim(2))
  ! Allocate respective space for each file
  allocate (huvin%r2d(huvin%gil%dim(1),nblock), stat=ier)
  if (ier.ne.0) then
    write(mess,*) 'Memory allocation error ',huvin%gil%dim(1), nblock
    call map_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Loop over line table by block
  huvin%blc = 0
  huvin%trc = 0
  !
  do ib = 1,huvin%gil%dim(2),nblock
    write(mess,*) ib,' / ',huvin%gil%dim(2),nblock
    call map_message(seve%i,rname,mess)
    huvin%blc(2) = ib
    huvin%trc(2) = min(huvin%gil%dim(2),ib-1+nblock)
    invisi = huvin%trc(2)-huvin%blc(2)+1
    call gdf_read_data(huvin,huvin%r2d,error)
    if (error) return
    !
    if (icode.eq.0) then
      do iv=1,invisi
        isou = huvin%r2D(ixoff,iv)
        if (isou.gt.0 .and. isou.le.nf) then
          huvin%r2d(ixoff,iv) = offs(1,isou)
          huvin%r2d(iyoff,iv) = offs(2,isou)
        else
          write(mess,'(A,I0,A,I0)') 'Invalid source ID ',isou,' for visibility ',iv
          call map_message(seve%w,rname,mess)
        endif
      enddo
    else
      do iv=1,invisi
        isou = huvin%r2D(ixoff,iv)
        rsou = isou
        if (rsou.ne.huvin%r2D(ixoff,iv)) then  
          mess = 'Non integer field number'
          error = .true.
        else if (isou.lt.1 .or. isou.gt.nf) then
          mess = 'Field number out of range'
          error = .true.
        endif
        if (error) then
          call map_message(seve%e,rname,mess)
          error = .true.
          return
        endif
        huvin%r2d(ixoff,iv) = offs(1,isou)
        huvin%r2d(iyoff,iv) = offs(2,isou)
      enddo
    endif
    !
    call gdf_write_data (huvin,huvin%r2d,error)
    if (error) return
  enddo
  !
  ! Finalize the image
  call gdf_update_header(huvin,error)
  if (error) return
  call gdf_close_image(huvin,error)
end subroutine sub_file_fields

subroutine sub_memory_fields (huvin, duv, nf, offs, error)
  use gkernel_interfaces
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support for @ fits_to_uvt.map
  !     Replace fields ID by Fields offsets
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: huvin     ! Input / Output file UV header
  real, intent(inout) :: duv(:,:)          ! UV data
  integer, intent(in) :: nf                ! Number of fields
  real(kind=8), intent(in) :: offs(2,nf)   ! Offset values
  logical, intent(out) :: error            ! Error flag
  !
  ! Local variables
  character(len=*), parameter :: rname='UV_FIELDS'
  character(len=80)  :: mess
  integer :: iv, ixoff, iyoff, isou, icode
  real :: rsou
  !
  if (huvin%loca%size.eq.0) then
    call map_message(seve%e,rname,'No UV data')
    error = .true.
    return
  endif  
  !
  ! Update the proper columns
  if (huvin%gil%column_size(code_uvt_id).ne.0) then
    call map_message(seve%i,rname,'Replacing Field numbers by PHASE offsets')
    ixoff = huvin%gil%column_pointer(code_uvt_id)
    iyoff = ixoff+1
    huvin%gil%column_pointer(code_uvt_loff) = ixoff
    huvin%gil%column_pointer(code_uvt_moff) = iyoff
    huvin%gil%column_size(code_uvt_loff) = 1
    huvin%gil%column_size(code_uvt_moff) = 1
    huvin%gil%column_pointer(code_uvt_id) = 0
    huvin%gil%column_size(code_uvt_id) = 0
    icode = 0
  else if (huvin%gil%column_size(code_uvt_loff).ne.0) then
    ixoff =     huvin%gil%column_pointer(code_uvt_loff)
    iyoff =     huvin%gil%column_pointer(code_uvt_moff)
    icode = 1
    call map_message(seve%e,rname,'UV Table is already of type PHASE') 
    error = .true.
  else if (huvin%gil%column_size(code_uvt_xoff).ne.0) then
    ixoff =     huvin%gil%column_pointer(code_uvt_xoff)
    iyoff =     huvin%gil%column_pointer(code_uvt_yoff)
    icode = -1
    call map_message(seve%e,rname,'UV Table is already of type POINT') 
    error = .true.
  else
    call map_message(seve%e,rname,'UV table is not a mosaic')
    error = .true.
  endif
  if (error) return
  !
  if (icode.eq.0) then
    do iv=1,huvin%gil%nvisi
      isou = duv(ixoff,iv)
      if (isou.gt.0 .and. isou.le.nf) then
        duv(ixoff,iv) = offs(1,isou)
        duv(iyoff,iv) = offs(2,isou)
      else
        write(mess,'(A,I0,A,I0)') 'Invalid source ID ',isou,' for visibility ',iv
        call map_message(seve%w,rname,mess)
        error = .true.
        return
      endif
    enddo
  else
    do iv=1,huvin%gil%nvisi
      isou = duv(ixoff,iv)
      rsou = isou
      if (rsou.ne.duv(ixoff,iv)) then  
        mess = 'Non integer field number'
        error = .true.
      else if (isou.lt.1 .or. isou.gt.nf) then
        mess = 'Field number out of range'
        error = .true.
      endif
      if (error) then
        call map_message(seve%e,rname,mess)
        return
      endif
      duv(ixoff,iv) = offs(1,isou)
      duv(iyoff,iv) = offs(2,isou)
    enddo
  endif
end subroutine sub_memory_fields
