program uv_update_fields
  use gildas_def
  use image_def
  use gkernel_interfaces
  !----------------------------------------------------------------------
  ! GILDAS
  !   Task for @ fits_to_uvt.map
  !     Replace fields ID by Fields offsets
  !     The Fiels 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=filename_length) :: uvdata, fields
  character(len=32) :: chain
  integer :: nf, ier, i, j
  integer :: lun=1
  real, allocatable :: raoff(:),deoff(:)
  real :: off(2)
  logical :: error
  !
  ! Code:
  error = .false.
  call gildas_open
  call gildas_char('UVDATA$',uvdata)
  call gildas_inte('NFIELDS$',nf,1)
  !
  allocate (raoff(abs(nf)),deoff(abs(nf)),stat=ier)
  if (ier.ne.0) then
    call gagout('E-UV_UPDATE_FIELDS, Memory allocation error')
    call sysexi(fatale)
  endif
  !
  if (nf.lt.0) then
    nf = -nf
    call gildas_char('FIELD_LIST$',fields)
    call gildas_close
    !
    open(unit=lun,file=fields,status='OLD',iostat=ier)
    if (ier.ne.0) then
      call gagout('E-UV_UPDATE_FIELDS, Error opening '//trim(fields))
      call putios('E-UV_UPDATE_FIELDS, ',ier)
      call sysexi(fatale)
    endif
    !
    do i=1,nf
      read(lun,*) j, off(1:2)
      if (j.ne.i) then
        call gagout('E-UV_UPDATE_FIELDS, Unordered field list')
        call sysexi(fatale)
      else
        raoff(i) = off(1)
        deoff(i) = off(2)
      endif
    enddo
    close(unit=lun)
  else
    do i=1,nf
      write(chain,'(a,i0,a)') 'FIELD_',i,'$'
      call gildas_real(chain,off,2)
      raoff(i) = off(1)
      deoff(i) = off(2)
    enddo
    call gildas_close
  endif
  call sub_update_fields(uvdata,nf,raoff,deoff,error)
  if (error) call sysexi(fatale)
  call gagout ('S-UV_UPDATE_FIELDS,  Successful completion')
end program uv_update_fields
!
subroutine sub_update_fields (cuvin, nf,raoff,deoff,error)
  use gkernel_interfaces
  use image_def
  use gbl_message
  !---------------------------------------------------------------------
  ! GILDAS
  !   Support for @ fits_to_uvt.map
  !     Replace fields ID by Fields offsets
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: cuvin
  integer, intent(in) :: nf
  real, intent(in) :: raoff(nf), deoff(nf)
  logical, intent(out) :: error
  !
  ! Local variables
  character(len=*), parameter :: rname='UV_UPDATE_FIELDS'
  character(len=80)  :: mess
  type (gildas) :: uvin
  integer :: ier, nblock, ib, invisi, iv, ixoff, iyoff, isou, icode
  real :: rsou
  !
  ! Simple checks
  error = len_trim(cuvin).eq.0
  if (error) then
    call gag_message(seve%e,rname,'No input UV table name')
    return
  endif
  !
  call gildas_null (uvin, type = 'UVT')     ! Define a UVTable gildas header
  call gdf_read_gildas (uvin, cuvin, '.uvt', error, data=.false.)
  if (error) then
    call gag_message(seve%e,rname,'Cannot read input UV table')
    return
  endif
  !
  ! Update the proper columns
  if (uvin%gil%column_size(code_uvt_id).ne.0) then
    call gag_message(seve%i,rname,'Replacing Field numbers by PHASE offsets')
    ixoff = uvin%gil%column_pointer(code_uvt_id)
    iyoff = ixoff+1
    uvin%gil%column_pointer(code_uvt_loff) = ixoff
    uvin%gil%column_pointer(code_uvt_moff) = iyoff
    uvin%gil%column_size(code_uvt_loff) = 1
    uvin%gil%column_size(code_uvt_moff) = 1
    uvin%gil%column_pointer(code_uvt_id) = 0
    uvin%gil%column_size(code_uvt_id) = 0
    icode = 0
  else if (uvin%gil%column_size(code_uvt_loff).ne.0) then
    ixoff =     uvin%gil%column_pointer(code_uvt_loff)
    iyoff =     uvin%gil%column_pointer(code_uvt_moff)
    call gag_message(seve%w,rname,'UV Table is already of type PHASE, checking Field numbers')
    icode = 1
  else if (uvin%gil%column_size(code_uvt_xoff).ne.0) then
    ixoff =     uvin%gil%column_pointer(code_uvt_xoff)
    iyoff =     uvin%gil%column_pointer(code_uvt_yoff)
    call gag_message(seve%w,rname,'UV Table is already of type POINT, checking Field numbers')
    icode = -1
  else
    call gag_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,uvin%gil%dim(1)) ! Visibilities at once
  nblock = min(nblock,uvin%gil%dim(2))
  ! Allocate respective space for each file
  allocate (uvin%r2d(uvin%gil%dim(1),nblock), stat=ier)
  if (ier.ne.0) then
    write(mess,*) 'Memory allocation error ',uvin%gil%dim(1), nblock
    call gag_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Loop over line table by block
  uvin%blc = 0
  uvin%trc = 0
  !
  do ib = 1,uvin%gil%dim(2),nblock
    write(mess,*) ib,' / ',uvin%gil%dim(2),nblock
    call gag_message(seve%i,rname,mess)
    uvin%blc(2) = ib
    uvin%trc(2) = min(uvin%gil%dim(2),ib-1+nblock)
    invisi = uvin%trc(2)-uvin%blc(2)+1
    call gdf_read_data(uvin,uvin%r2d,error)
    !
    if (icode.eq.0) then
      do iv=1,invisi
        isou = uvin%r2D(ixoff,iv)
        uvin%r2d(ixoff,iv) = raoff(isou)
        uvin%r2d(iyoff,iv) = deoff(isou)
      enddo
    else
      do iv=1,invisi
        isou = uvin%r2D(ixoff,iv)
        rsou = isou
        if (rsou.ne.uvin%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 gag_message(seve%e,rname,mess)
          return
        endif
        uvin%r2d(ixoff,iv) = raoff(isou)
        uvin%r2d(iyoff,iv) = deoff(isou)
      enddo
    endif
    !
    call gdf_write_data (uvin,uvin%r2d,error)
    if (error) return
  enddo
  !
  ! Finalize the image
  call gdf_update_header(uvin,error)
  if (error) return
  call gdf_close_image(uvin,error)
end subroutine sub_update_fields
