!
subroutine init_fields(huvl,print,error)
  use gkernel_interfaces
  use image_def
  use clean_arrays
  use clean_default
  use gbl_message
  use imager_interfaces, only : load_fields, map_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER  -- Support routine for the Sault et al Mosaicking method
  !
  ! Define the associated MOSAIC Table and load the Field coordinates
  ! (Pointing and Phases)
  !  
  ! Sault et al Mosaicking method.  
  !   See Sault, Staveley-Smith and Brouw
  !   A&A Supp Ser 120, 375-384 (1995)
  !
  ! The principle of the Sault & al Mosaicking technique is
  ! to minimize spatial distortion and intermediate image
  ! sizes by
  !   - limiting each pointing field to about 2-3 primary beams
  !   - and accordingly, limiting each individual dirty beam
  !     in the same way
  !   - properly reprojecting each pointing to the common tangent
  !     plane
  !   - phasing each pointing to the nearest pixel as a Phase center
  !
  ! For proper use, it must carry along the individual Pixel shifts
  ! for each field, and the fractional offset centers.
  !
  ! The gain in size can be substantial for Large mosaics.
  ! E.g. for a NxN square mosaic, about (N/4)^2
  ! A similar gain occurs in computation, since FFTs scale 
  !   as M log(M)
  ! This also shows that there is no need for this method for
  ! "small" mosaics, as the gain only start for 16 pointings
  ! at least.
  !
  ! Unfortunately, the Gildas Data Format does not easily accomodate
  ! a "pixel offset" compared to some reference.  This information can 
  ! readily be retrieved from an absolute coordinate difference,
  ! but there is no simple way to have it in e.g. a 3-D data cube
  ! of different pointings.
  
  ! This handling is done in the code, through the %MOS allocatable
  ! structure, a "pseudo-table" attached to the UV data header.
  !   This is done by a modification of the (internal) Gildas Data Format
  !   similar to the "Telescope" section or "Frequencies" section, in
  !   a "Mosaic" section with the relevant information, but not stored
  !   in data file.
  !
  ! The %MOS% structure contains the number of fields and for each field 
  ! a sub-structure of type "field_par"
  ! type :: field_par
  !  sequence
  !  !! Field characteristics, Pointing centers and related issues
  !  real(8) :: apoint(2)       !! RA and Dec of Pointing Centers
  !  real(8) :: aphase(2)       !! RA and Dec of Phase Centers
  !  real(4) :: opoint(2)       !! Pointing Offsets
  !  real(4) :: ophase(2)       !! Phase Offsets
  !  integer :: jxy(2)          !! Pixel Offsets
  !  real(4) :: oxy(2)          !! Fractional Phase Offset
  !  integer :: nvisi           !! Number of visibilities
  !  real :: sigma              !! Noise level
  ! end type field_par
  ! Offsets are derived from the absolute values when imaging, with a 
  ! given Pixel size and Mosaic center. This is done by the 
  ! MOSAIC_SET_HEADER routine. 
  !  
  ! If some of these informations were saved on disk with the Gildas Header, 
  ! the Mosaicked Image could then have a different size than the 
  ! Primary & Dirty beams. 
  !
  !   The SHOW FIELDS tool could use directly this information, 
  ! if it contains some idea of the Primary beam size, that could 
  ! also serve as checking facts (e.g. pixel sizes, Mosaic center)
  !
  !   When using this imaging mode, the UV table is modified to
  ! have a field ID column, rather than either the Phase or 
  ! Pointing offsets columns. Note that this mode can even
  ! handle simultaneously Pointing and Phase offsets columns
  ! in case they would differ.
  !
  !   This structure is closer to the UVFITS handling convention
  ! (AIPS or CASA "Pointing" table)
  !
  !!
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: huvl  !! UV Header
  logical, intent(in) :: print         !! Printout field coordinates ?
  logical, intent(inout) :: error      !! Logical error flag
  !
  ! Constants
  character(len=*), parameter :: rname='POINTING'
  !
  ! Local ---
  integer :: ier
  !
  ! Code ----
  call imager_tree('INIT_FIELDS',.false.)
  error = .false.
  if (.not.allocated(duvi)) then
    call map_message(seve%e,rname,'No UV data loaded')
    error = .true.
    return
  endif
  !
  ! 1) Set the TABLE
  if (allocated(huvl%mos%fields)) then
    deallocate(huvl%mos%fields,stat=ier)
    if (ier.ne.0) then 
      call map_message(seve%e,rname,'Mosaic Header Deallocation error') 
      error = .true.
      return
    endif
  endif
  !
  huvl%r2d => duv ! Pointer must be associated
  call load_fields(rname,huvl,abs(themap%nfields),error)
  if (error) return
  !
  mosaic_mode = 'SAULT'
  call imager_tree('INIT_FIELDS',.true.)
  !
end subroutine init_fields
!
subroutine load_fields(rname,huvl,mfi,error)
  use gkernel_interfaces
  use gkernel_types
  use clean_def
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER --   
  !     Scan a Mosaic UV data to find out the number of fields
  !     and their positions, and replace the corresponding columns
  !     by Fields ID numbers. 
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname       !! Calling command
  type(gildas), intent(inout) :: huvl         !! UV header & data 
  integer, intent(in) :: mfi                  !! Number of fields
  logical, intent(inout) :: error             !! Logical error flag
  ! 
  ! Local ---
  integer :: np                   ! Size of a visibility
  integer :: nv                   ! Number of visibilities
  integer :: ixoff,iyoff          ! X,Y Pointing pointer
  integer :: iloff,imoff          ! L,M Phase pointer
  integer :: ioff,joff            ! Actual offset pointer
  integer :: idoff                ! ID pointer
  integer :: itele                ! Telescope pointer
  integer :: iv, ier, ip
  integer :: ifi, kfi, nfi
  real(4), allocatable :: doff(:,:)
  real(8), allocatable :: poff(:,:), pabs(:,:)
  integer, allocatable :: dvis(:), jtel(:)
  type(projection_t) :: proj
  !
  logical :: debug
  !
  ! Code ----
  debug = .false.
  call sic_get_logi('DEBUG_MOSAIC',debug,error)
  error = .false.
  !
  ixoff = huvl%gil%column_pointer(code_uvt_xoff)
  iyoff = huvl%gil%column_pointer(code_uvt_yoff)
  iloff = huvl%gil%column_pointer(code_uvt_loff)
  imoff = huvl%gil%column_pointer(code_uvt_moff)
  idoff = huvl%gil%column_pointer(code_uvt_id)
  itele = huvl%gil%column_pointer(code_uvt_tele)
  !
  if ((ixoff*iyoff).ne.0) then
    ! Usual Pointing Offsets Mosaic. A Common Phase center
    ioff = ixoff
    joff = iyoff
    if (debug) Print *,'Point offset mosaic'
  else if ((iloff*imoff).ne.0) then
    ! Phase Offsets Mosaic. Pointing & Phase centers match.
    ioff = iloff
    joff = imoff
    if (debug) Print *,'Phase offset mosaic'
  else   
    if (idoff.eq.0) then
      call map_message(seve%e,rname,'Data is not a Mosaic')
      error = .true.
    else if (allocated(huvl%mos%fields)) then
      ! More checks needed (Number of fields at least ?) 
      ip = maxval(huvl%r2d(idoff,:))
      if (ip.ne.mfi) then
        call map_message(seve%e,rname,'Mosaic and Mosaic Header mismatch')
        error = .true.
      else
        call map_message(seve%w,rname,'Mosaic already has an associated Mosaic Header')
      endif
    else
      call map_message(seve%e,rname,'Mosaic with no associated Mosaic Header')
      error = .true.
    endif
    return
  endif
  !
  ! Re-use Ioff column if no ID column
  if (debug) then 
    if (allocated(huvl%mos%fields)) Print *,'HMOS allocated'
    Print *,'IDOFF ',idoff, ixoff,iyoff, size(huvl%r2d,1)
  endif
  if (idoff.eq.0) idoff = ioff
  if (allocated(huvl%mos%fields)) deallocate(huvl%mos%fields)
  !
  np = huvl%gil%dim(1)   ! Size of a visibility
  nv = huvl%gil%nvisi    ! Number of visibilities
  allocate(doff(mfi,2),dvis(mfi),jtel(mfi),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  if (debug) Print *,'Allocation status ',associated(huvl%r2d)
  !
  ! Scan how many fields
  nfi = 1  
  doff(1,1) = huvl%r2d(ioff,1)
  doff(1,2) = huvl%r2d(joff,1)
  huvl%r2d(idoff,1) = nfi
  dvis(1) = 1
  jtel = 1
  if (itele.ne.0) jtel(1) = huvl%r2d(itele,1)  
  !
  if (debug) Print *,'Starting LOOP MFI ',mfi
  do iv=2,nv
    kfi = 0
    do ifi=1,nfi
      if (huvl%r2d(ioff,iv).eq.doff(ifi,1) .and. &
      & huvl%r2d(joff,iv).eq.doff(ifi,2) ) then
        if (itele.eq.0) then
          kfi = ifi
          huvl%r2d(idoff,iv) = ifi
          dvis(ifi) = dvis(ifi)+1          
          exit
        else
          if (huvl%r2d(itele,iv).eq.jtel(ifi)) then
            kfi = ifi
            huvl%r2d(idoff,iv) = ifi
            dvis(ifi) = dvis(ifi)+1
            jtel(nfi) = huvl%r2d(itele,iv)
            exit
          endif
        endif
      endif
    enddo
    !
    ! New field
    if (kfi.eq.0) then
      nfi = nfi+1
      doff(nfi,1) = huvl%r2d(ioff,iv)
      doff(nfi,2) = huvl%r2d(joff,iv)
      if (itele.ne.0) jtel(nfi) = huvl%r2d(itele,iv)
      huvl%r2d(idoff,iv) = nfi
      dvis(nfi) = 1
    endif
  enddo
  if (nfi.eq.1) then
    call map_message(seve%w,rname,'Degenerate mosaic with 1 field only')
    return
  endif
  !
  if (nfi.ne.mfi) Print *,'I am in trouble ...', nfi, mfi
  allocate(huvl%mos%fields(nfi),pabs(nfi,2),poff(nfi,2),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Mosaic Header Memory allocation error')
    error = .true.
    return
  endif
  if (debug) Print *,'NFI ',nfi
  !
  poff(:,:) = doff(1:nfi,:)
  !
  ! Define the projection about the Tangent point
  call gwcs_projec(huvl%gil%a0,huvl%gil%d0,huvl%gil%pang,huvl%gil%ptyp,proj,error)
  call rel_to_abs (proj,poff(:,1),poff(:,2),pabs(:,1),pabs(:,2),nfi)
  if (debug) Print *,'Done rel_to_abs'
  !
  ! Also set the huvl%mos Mosaic Sub-header
  if (allocated(huvl%mos%fields)) deallocate(huvl%mos%fields)
  allocate(huvl%mos%fields(nfi),stat=ier)
  huvl%mos%nfields = nfi
  ! Store
  if ((iloff*imoff).ne.0) then
    ! A Pointing & Phase Centers match
    if (debug) Print *,'Case 1'
    do ip=1,nfi
      !
      huvl%mos%fields(ip)%apoint(1:2) = pabs(ip,1:2)
      huvl%mos%fields(ip)%aphase(1:2) = pabs(ip,1:2)
      huvl%mos%fields(ip)%opoint(1:2) = poff(ip,1:2)
      huvl%mos%fields(ip)%ophase(1:2) = poff(ip,1:2)
      huvl%mos%fields(ip)%nvisi = dvis(ip)
      huvl%mos%fields(ip)%jteles = mod(jtel(ip),100)
    enddo
    if (huvl%gil%column_pointer(code_uvt_id).eq.0) then
      huvl%gil%column_pointer(code_uvt_loff) = 0
      huvl%gil%column_pointer(code_uvt_moff) = 0
      huvl%gil%column_size(code_uvt_loff) = 0
      huvl%gil%column_size(code_uvt_moff) = 0
      huvl%gil%column_pointer(code_uvt_id) = ioff
      huvl%mos%fields(ip)%jteles = mod(jtel(ip),100)
    endif
  else
    if (debug) Print *,'Case 2'
    ! Phase Center was common
    ! A Pointing & Phase Centers match
    do ip=1,nfi
      !
      huvl%mos%fields(ip)%apoint(1:2) = pabs(ip,1:2)
      huvl%mos%fields(ip)%aphase(1:2) = [huvl%gil%a0,huvl%gil%d0]
      huvl%mos%fields(ip)%opoint(1:2) = poff(ip,1:2)
      huvl%mos%fields(ip)%ophase(1:2) = 0.
      huvl%mos%fields(ip)%nvisi = dvis(ip)
      huvl%mos%fields(ip)%jteles = mod(jtel(ip),100)
    enddo
    if (huvl%gil%column_pointer(code_uvt_id).eq.0) then
      huvl%gil%column_pointer(code_uvt_xoff) = 0
      huvl%gil%column_pointer(code_uvt_yoff) = 0
      huvl%gil%column_size(code_uvt_xoff) = 0
      huvl%gil%column_size(code_uvt_yoff) = 0
      huvl%gil%column_pointer(code_uvt_id) = ioff
      huvl%mos%fields(ip)%jteles = mod(jtel(ip),100)
    endif
  endif
  if (debug) Print *,'Nullifying offsets '
  do ip=1,nfi
    huvl%mos%fields(ip)%jxy = 0
    huvl%mos%fields(ip)%oxy = 0
  enddo
  deallocate(poff,pabs,dvis,doff)
  if (debug) Print *,'Deallocated arrays'
  !
  huvl%gil%column_size(code_uvt_id) = 1
  call imager_tree('LOAD_FIELDS',.true.)
  !
end subroutine load_fields
!
subroutine change_fields(rname,nfi,hmos,newabs,error)
  use gkernel_interfaces
  use gkernel_types
  use clean_def
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !*
  ! IMAGER -- Change the associated Mosaic Table to a new Reference center
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname         !! Calling command
  integer, intent(in) :: nfi                    !! Number of fields
  type(field_par), intent(inout) :: hmos(:)     !! Mosaic Header
  real(8), intent(in) :: newabs(3)              !! Coordinates of center
  logical, intent(inout) :: error               !! Error flag
  !
  ! Local ---
  type(projection_t) :: proj
  real(8) :: ra(nfi), dec(nfi), offx(nfi), offy(nfi) ! Automatic arrays
  !
  ! Code ----
  !  
  ! Define the projection about the Projection center
  call gwcs_projec(newabs(1),newabs(2),newabs(3),p_azimuthal,proj,error)
  if (error) return
  !
  ra = hmos(:)%apoint(1)
  dec = hmos(:)%apoint(2)
  call abs_to_rel (proj,ra,dec,offx,offy,nfi)
  hmos(:)%opoint(1) = offx
  hmos(:)%opoint(2) = offy
  !
  ra = hmos(:)%aphase(1)
  dec = hmos(:)%aphase(2)
  call abs_to_rel (proj,ra,dec,offx,offy,nfi)
  hmos(:)%ophase(1) = offx
  hmos(:)%ophase(2) = offy
  !
end subroutine change_fields
!
subroutine fraction_fields(rname,hmos,map,mx,my,nx,ny,error)
  use gkernel_interfaces
  use gkernel_types
  use clean_def
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !*
  ! IMAGER -- Change the associated Mosaic Header to a new Reference
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname    !! Caller name (UV_MAP or MX)
  type (uvmap_par), intent(in) :: map      !! Map parameters
  type(field_par), intent(inout) :: hmos(:)     !! Mosaic header
  integer, intent(in) :: mx,my,nx,ny       !! Image sizes
  logical, intent(inout) :: error          !! Logical error flag
  !
  ! Constants
  real(8), parameter :: sec=180D0*3600d0/acos(-1D0)
  !
  ! Local ---
  integer :: if, nfield, idx, jdx, idy, jdy
  real(8) :: rdx, rdy, xinc, yinc
  !
  ! Code ----
  if (any(map%xycell.eq.0)) then
    call map_message(seve%e,rname,'Map cell not initialized')
    error = .true.
    return
  endif
  !
  ! This could be different between Phase & Pointing offsets tables ?
  nfield = abs(map%nfields)
  xinc =  -dble(map%xycell(1))              ! Sign is reversed along X
  yinc =  dble(map%xycell(2))
  do if=1,nfield
    idx = idnint(hmos(if)%opoint(1)/xinc)   ! X Pixel of the center
    rdx = hmos(if)%opoint(1)-idx*xinc       ! Offset of phase center (< 1 pixel)
    jdx = (mx-nx)/2+idx                     ! Pixel shift
    !
    idy = idnint(hmos(if)%opoint(2)/yinc)   ! Y Pixel of the center
    rdy = hmos(if)%opoint(2)-idy*yinc       ! Offset of phase center (< 1 pixel)
    jdy = (my-ny)/2+idy                     ! Pixel shift
    !
    hmos(if)%jxy(1)  = jdx
    hmos(if)%jxy(2)  = jdy
    hmos(if)%oxy(1)  = rdx
    hmos(if)%oxy(2)  = rdy
  enddo
end subroutine fraction_fields
!
subroutine sault_uv_change(nu,nv,visi,ap,dp,a0,d0)  
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER -- Support for Mosaicking in the Sault et al approach
  !
  ! Figure out  
  !     (u)        (u_p)  
  !     ( )  = R2T (  )  
  !     (v)  =     (v_p)  
  ! 
  ! the re-projection matrix that transforms the
  ! original (u_p,v_p) coordinates relative to the
  ! delay tracking center into the appropriate
  ! (u,v) coordinates relative to the final projection center
  !
  ! See Sault, Staveley-Smith and Brouw
  ! A&A Supp Ser 120, 375-384 (1995)
  !
  !---------------------------------------------------------------------
  integer, intent(in) :: nu             !! Visibility size
  integer, intent(in) :: nv             !! Number of visibilities
  real(4), intent(inout) :: visi(nu,nv) !! Visibilities
  real(8), intent(in) :: ap, dp         !! The original phase/pointing center
  real(8), intent(in) :: a0, d0         !! The common projection center
  !
  ! Local ---
  real(8) :: a11, a21, a12, a22, detn
  integer :: iv
  real(8) :: up, vp
  !
  ! Code ----
  !
  ! The R2T matrix elements are
  ! - Determinant
  detn = 1.d0/(sin(d0)*sin(dp) + cos(ap-a0)*cos(dp)*cos(d0))
  ! - Coefficients,
  ! Normalized to appropriate determinant
  a11 = (cos(ap-a0)*sin(dp)*sin(d0)+cos(dp)*cos(d0))*detn
  a21 = -sin(ap-a0)*sin(d0)*detn
  a12 = sin(ap-a0)*sin(dp)*detn
  a22 = cos(ap-a0)*detn
  !
  do iv=1,nv
    up = visi(1,iv)
    vp = visi(2,iv)
    visi(1,iv) = up*a11 + vp*a21
    visi(2,iv) = up*a12 + vp*a22
  enddo
end subroutine sault_uv_change
