subroutine mos_primary (prim,primary,bsize)
  use image_def
  use gkernel_interfaces
  use gkernel_types
  !--------------------------------------------------------------
  !*
  ! IMAGER -- Support routine for MOSAIC
  !
  ! Mosaic and Primary beam support.
  ! Compute a Gaussian primary beam
  !!
  !--------------------------------------------------------------
  type(gildas), intent(in) :: prim         !! Primary beam header
  real, intent(inout) :: primary(prim%gil%dim(1),prim%gil%dim(2)) !! Values
  real, intent(in) :: bsize                !! Primary beam size in radian
  !
  ! Local
  real :: offx,offy,beamx,beamy
  real, allocatable :: factorx(:),factory(:)
  real(8) :: doffx, doffy
  integer :: j, ier
  type(projection_t) :: proj
  logical :: error
  !
  allocate (factory(prim%gil%dim(2)), factorx(prim%gil%dim(1)), stat=ier)
  !
  error = .false.
  call gwcs_projec(prim%gil%a0,prim%gil%d0,prim%gil%pang,prim%gil%ptyp,proj,error)
  call abs_to_rel(proj,prim%gil%ra,prim%gil%dec,doffx,doffy,1)
  offx = doffx/prim%gil%inc(1)
  offy = doffy/prim%gil%inc(2)
  !
  beamx = prim%gil%inc(1)/bsize*2.0*sqrt(log(2.0))
  beamy = prim%gil%inc(2)/bsize*2.0*sqrt(log(2.0))
  !
  do j=1,prim%gil%dim(2)
     factory(j) = exp(-((j-prim%gil%ref(2)-offy)*beamy)**2)
  enddo
  !
  do j=1,prim%gil%dim(1)
     factorx(j) = exp(-((j-prim%gil%ref(1)-offx)*beamx)**2)
  enddo
  !
  do j=1,prim%gil%dim(2)
     primary(:,j) = factorx * factory(j)
  enddo
  deallocate (factorx, factory)
end subroutine mos_primary
!
subroutine mos_inverse (n,weight,thre)
  !! IMAGER -- Returns the inverse for the weights for Mosaic
  integer, intent(in) :: n          !! Size of problem
  real, intent(inout) :: weight(n)  !! Weight to be inversed
  real, intent(in) :: thre          !! Threhsold
  ! Local
  integer :: i
  !
  do i=1,n
    if (weight(i).ge.thre) then
      weight(i) = 1.0/weight(i)
    else
      weight(i) = 10.0
    endif
  enddo
end subroutine mos_inverse
!
subroutine mos_addsq (n,nf,weight,lobe)
  !! IMAGER -- Increment weights by Square of primary beam
  integer, intent(in) :: n                      !! Size of arrays
  integer, intent(in) :: nf                     !! Number of fields
  real, intent(inout) :: weight(n)              !! Total weight
  real, intent(in) :: lobe(nf,n)                !! Primary beam array
  ! Local
  integer :: i,if
  !
  do i=1,n
    do if=1,nf
      weight(i) = weight(i)+lobe(if,i)*lobe(if,i)
    enddo
  enddo
end subroutine mos_addsq
!
subroutine mosaic_loadfield (visi,np,nv,ixoff,iyoff,nf,doff,voff,uvmax,uvmin)
  !----------------------------------------------------------------------
  ! @ public-mandatory
  !
  ! IMAGER  --  MOSAIC routines
  !
  !     Load field coordinates into work arrays after sorting.
  !!
  !----------------------------------------------------------------------
  integer, intent(in)  :: np              !! Size of a visibility
  integer, intent(in)  :: nv              !! Number of visibilities
  real, intent(in) :: visi(np,nv)         !! Input visibilities
  integer, intent(in)  :: ixoff           !! X pointer
  integer, intent(in)  :: iyoff           !! Y pointer
  integer, intent(out) :: nf              !! Number of fields
  real(kind=4), intent(out) :: doff(:,:)  !! Fields offsets
  integer, intent(out) :: voff(:)         !! Fields visibility offsets
  real, intent(inout) :: uvmax            !! Maximum length
  real, intent(inout) :: uvmin            !! Minimum baseline
  !
  ! Local ---
  integer :: iv, mfi, nfi
  real(4) :: uv
  !
  ! Code ----
  ! Scan how many fields
  nfi = 1
  mfi = ubound(doff,2)
  uvmax = 0
  uvmin = 1e36
  !
  doff(1,1) = visi(ixoff,1)
  doff(2,1) = visi(iyoff,1)
  voff(1) = 1
  nfi = 1
  !
  ! Fields are ordered here, so any change is a new one
  do iv=2,nv
    if (visi(ixoff,iv).ne.doff(1,nfi) .or. &
      & visi(iyoff,iv).ne.doff(2,nfi) ) then
      !
      ! New field
      if (nfi.eq.mfi) then
        Print *,'Programming error : number of fields exceeded ',mfi,' at visi ',iv
        Print *,'DOFF x ',doff(1,1:nfi)
        Print *,'DOFF Y ',doff(2,1:nfi)
        Print *,'Visi   ',visi(ixoff,iv),visi(iyoff,iv)
        Print *,'NP ',np,' IX IY ',ixoff,iyoff
      endif
      !
      nfi = nfi+1
      doff(1,nfi) = visi(ixoff,iv)
      doff(2,nfi) = visi(iyoff,iv)
      voff(nfi) = iv
    endif
    !
    uv = visi(1,iv)**2 + visi(2,iv)**2
    if (uv.ne.0) then
      uvmax = max(uv,uvmax)
      uvmin = min(uv,uvmin)
    endif
    !
  enddo
  !
  ! And set the last one
  voff(nfi+1) = nv+1
  !
  uvmax = sqrt(uvmax)
  uvmin = sqrt(uvmin)
end subroutine mosaic_loadfield
!
subroutine mosaic_getfields (visi,np,nv,ixoff,iyoff,itele,nf,doff,jtele)
  !----------------------------------------------------------------------
  ! @ public-mandatory
  !*
  ! IMAGER  --   MOSAIC routines
  !
  !     Count number of fields and Get their coordinates
  !     and telescope IDs
  !!
  !----------------------------------------------------------------------
  integer, intent(in)  :: np                   !! Size of a visibility
  integer, intent(in)  :: nv                   !! Number of visibilities
  real, intent(inout)  :: visi(np,nv)          !! Input visibilities
  integer, intent(in)  :: ixoff                !! X pointer
  integer, intent(in)  :: iyoff                !! Y pointer
  integer, intent(in)  :: itele                !! Telescope pointer
  integer, intent(out) :: nf                   !! Number of fields
  real, intent(out), allocatable :: doff(:,:)  !! Field offsets
  integer, intent(out), allocatable :: jtele(:) !! Telescope number
  !
  ! Tolerance precision for phase center: 0.1 mas, to keep
  ! direction changes due to typical Proper Motions
  real(kind=4), parameter :: off_tol=1E-4*acos(-1.0)/180.0/3600.0
  !
  ! Local ---
  integer :: iv, mfi, nfi, kfi, ifi, ier
  real(kind=4), allocatable :: dtmp(:,:)
  real, allocatable :: dtel(:), rtel(:)
  !
  ! Code ----
  !
  ! Scan how many fields
  nfi = 1
  mfi = 100
  !
  if (allocated(doff)) deallocate(doff)        ! Safety measure
  if (allocated(jtele)) deallocate(jtele)        ! Safety measure
  allocate(dtmp(2,mfi),dtel(mfi),stat=ier)
  dtmp(1,1) = visi(ixoff,1)
  dtmp(2,1) = visi(iyoff,1)
  if (itele.ne.0) dtel(1) = visi(itele,1)
  nfi = 1
  !
  ! Fields are not ordered here
  do iv=2,nv
    kfi = 0
    do ifi=1,nfi
      if (abs(visi(ixoff,iv)-dtmp(1,ifi)).le.off_tol .and. &
        & abs(visi(iyoff,iv)-dtmp(2,ifi)).le.off_tol ) then
        if (itele.ne.0) then
          if (visi(itele,iv).eq.dtel(ifi)) then
            visi(ixoff,iv) = dtmp(1,ifi)
            visi(iyoff,iv) = dtmp(2,ifi)
            kfi = ifi
            exit
          endif
        else
          visi(ixoff,iv) = dtmp(1,ifi)
          visi(iyoff,iv) = dtmp(2,ifi)
          kfi = ifi
          exit
        endif
      endif
    enddo
    !
    ! New field
    if (kfi.eq.0) then
      if (nfi.eq.mfi) then
        allocate(doff(2,mfi),rtel(mfi),stat=ier)
        doff(:,:) = dtmp(:,:)
        rtel(:) = dtel(:)
        deallocate(dtmp,dtel)
        allocate(dtmp(2,2*mfi),dtel(2*mfi),stat=ier)
        dtmp(:,1:mfi) = doff
        dtel(1:mfi) = rtel
        deallocate(doff,rtel)
        mfi = 2*mfi
      endif
      nfi = nfi+1
      dtmp(1,nfi) = visi(ixoff,iv)
      dtmp(2,nfi) = visi(iyoff,iv)
      if (itele.ne.0) dtel(nfi) = visi(itele,iv)
    endif
  enddo
  !
  nf = nfi
  allocate(doff(2,nf),jtele(nf),stat=ier)
  doff(:,:) = dtmp(1:2,1:nf)
  if (itele.eq.0) then
    jtele = 1
  else
    jtele(:) = dtel(1:nf)
    jtele = mod(jtele,100)
  endif
end subroutine mosaic_getfields

