subroutine extracs (np,nx,ny,ip,in,out,lx,ly)
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER - Utility routine
  !
  !     Extract a Fourier plane from the FFT cube.
  !     Plane and Cube may have different X,Y dimensions
  !----------------------------------------------------------------------
  integer,intent(in) :: np  !! Number of planes
  integer,intent(in) :: nx  !! output FFT X plane size
  integer,intent(in) :: ny  !! output FFT Y plane size
  integer,intent(in) :: ip  !! Plane to be extracted
  integer,intent(in) :: lx  !! input FFT cube X plane size
  integer,intent(in) :: ly  !! input FFT cube Y plane size
  complex,intent(in) :: in(np,lx,ly) !! Input FFT cube
  complex,intent(out) :: out(nx,ny)  !! Output 2-D FFT
  !
  ! Local ---
  integer i,j,my,mx,kx,ky,ii,jj
  !
  ! Code ----
  mx = nx/2
  my = ny/2
  kx = lx/2
  ky = ly/2
  !
  out = 0.0
  !
  do j=1,ky
    jj = j+my-ky
    do i=1,kx
      ii = i+mx-kx
      out(ii+mx,jj+my) = in(ip,i,j)
    enddo
    do i=1,kx
      out(i,jj+my) = in(ip,i+kx,j)
    enddo
  enddo
  do j=1,ky
    do i=1,kx
      ii = i+mx-kx
      out(ii+mx,j) = in(ip,i,j+ky)
    enddo
    do i=1,kx
      out(i,j) = in(ip,i+kx,j+ky)
    enddo
  enddo
end subroutine extracs
!
subroutine extrac (np,nx,ny,ip,in,out)
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER -- Utility routine
  !
  !     Extract a Fourier plane from an FFT cube
  !     Plane and Cube must have same X,Y dimensions
  !----------------------------------------------------------------------
  integer,intent(in) :: np  !! Number of planes
  integer,intent(in) :: nx  !! FFT X plane size
  integer,intent(in) :: ny  !! FFT Y plane size
  integer,intent(in) :: ip  !! Plane to be extracted
  complex,intent(in) :: in(np,nx,ny) !! Input FFT cube
  complex,intent(out) :: out(nx,ny)  !! Output 2-D FFT
  !
  ! Local ---
  integer i,j,my,mx
  !
  ! Code ----
  mx = nx/2
  my = ny/2
  !
  do j=1,my
    do i=1,mx
      out(i+mx,j+my) = in(ip,i,j)
    enddo
    do i=1,mx
      out(i,j+my) = in(ip,i+mx,j)
    enddo
  enddo
  do j=1,my
    do i=1,mx
      out(i+mx,j) = in(ip,i,j+my)
    enddo
    do i=1,mx
      out(i,j) = in(ip,i+mx,j+my)
    enddo
  enddo
end subroutine extrac
!
subroutine dovisi (np,nv,visi,vv,ww,jw)
  !----------------------------------------------------------------------
  ! @ public
  !
  ! IMAGER -- Visibility handling routine
  !
  !   Extract V coordinate and Weight value
  !
  !----------------------------------------------------------------------
  integer, intent(in) :: np        !! Size of visibilities
  integer, intent(in) :: nv        !! Number of visibilities
  real, intent(in) :: visi(np,nv)  !! Visibilities
  real, intent(out) :: vv(nv)      !! V values
  real, intent(out) :: ww(nv)      !! Weight values
  integer, intent(in) :: jw        !! Weight column
  !
  integer i
  do i=1,nv
    vv(i) = visi(2,i)
    ww(i) = visi(jw,i)
  enddo
end subroutine dovisi
!
subroutine dogrid (corr,corx,cory,nx,ny,beam)
  !----------------------------------------------------------------------
  ! @ public
  !
  ! IMAGER -- Gridding routine
  !
  !   Compute grid correction array, with normalisation
  !   of beam to 1.0 at maximum pixel
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: nx         !! X size
  integer, intent(in) :: ny         !! Y size
  real, intent(in) :: beam(nx,ny)   !! Denormalized beam
  real, intent(in) :: corx(nx)      !! X grid correction
  real, intent(in) :: cory(ny)      !! Y Grid correction
  real, intent(out) :: corr(nx,ny)  !! Final grid correction and beam normalization
  !
  real(4) x
  integer  ::i,j
  !
  x = corx(nx/2+1)*cory(ny/2+1)/beam(nx/2+1,ny/2+1)
  do j=1,ny
    do i=1,nx
      corr(i,j) = x/(corx(i)*cory(j))
    enddo
  enddo
end subroutine dogrid
!
subroutine docorr (map,corr,nd)
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER - Gridding routine
  !
  !   Apply grid correction to map
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: nd         !! Number of data
  real, intent(inout) :: map(nd)    !! Data
  real, intent(in) :: corr(nd)      !! Correction
  integer i
  !
  do i=1,nd
    map(i) = map(i)*corr(i)
  enddo
end subroutine docorr
!
subroutine docoor (n,xinc,x)
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER  -- Grdding routine
  !
  !   Compute FFT grid coordinates in U or V
  !!
  !----------------------------------------------------------------------
  integer,intent(in) :: n     !! Number of values
  real, intent(out) :: x(n)   !! Values
  real, intent(in) :: xinc    !! Increment
  !
  integer :: i
  do i=1,n
    x(i) = float(i-n/2-1)*xinc
  enddo
end subroutine docoor
!
subroutine findp (nv,xx,xlim,nlim)
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER --  Utility routine
  !
  !   Find NLIM such that  
  !   XX(NLIM-1) < XLIM < XX(NLIM)  
  !   for input data ordered, retrieved from memory. It 
  !   assumes NLIM already preset so that XX(NLIM-1) < XLIM
  !----------------------------------------------------------------------
  integer, intent(in) :: nv       !! Number of values
  integer, intent(inout) :: nlim  !! Preset Position
  real, intent(in) :: xx(nv)      !! Input order value
  real, intent(in) :: xlim        !! Value to be located
  !
  ! Local ---
  integer :: ninf,nsup,nmid
  !
  ! Code ----
  if (xx(nv).lt.xlim) then
    nlim = nv+1
    return
  elseif (xx(nlim).gt.xlim) then
    return
  endif
  !
  ninf = nlim
  nsup = nv
  do while (nsup.gt.ninf+1)
    nmid = (nsup + ninf)/2
    if (xx(nmid).lt.xlim) then
      ninf = nmid
    else
      nsup = nmid
    endif
  enddo
  nlim = nsup
end subroutine findp
!
subroutine findm (nv,xx,xlim,nlim)
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER -- Utility routine 
  !
  !   Find NLIM such that   
  !     XX(NLIM-1) < XLIM < XX(NLIM)  
  !   for input data ordered, retrieved from memory. It
  !   assumes NLIM already preset so that XLIM < XX(NLIM)
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: nv        !! Number of values
  integer, intent(inout) :: nlim   !! Preset Position
  real, intent(in) :: xx(nv)       !! Input order value
  real, intent(in) :: xlim         !! Value to be located
  !
  ! Local ---
  integer :: ninf,nsup,nmid
  !
  ! Code -----
  if (xx(nv).lt.xlim) then
    nlim = nv+1
    return
  elseif (xx(1).gt.xlim) then
    nlim = 1
    return
  endif
  !
  nsup = nlim
  ninf = 1
  do while (nsup.gt.ninf+1)
    nmid = (nsup + ninf)/2
    if (xx(nmid).lt.xlim) then
      ninf = nmid
    else
      nsup = nmid
    endif
  enddo
  nlim = nsup
end subroutine findm
!
subroutine grdtab (n, buff, bias, corr)
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER -- Utility routine
  !
  !   Compute fourier transform of gridding function
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: n     !! Number of pixels, assuming center on N/2+1
  real, intent(in) :: buff(*)  !! Gridding function, tabulated every 1/100 cell
  real, intent(in) :: bias     !! Center of gridding function
  real, intent(out) :: corr(n) !! Gridding correction FT
  !
  ! PI is defined with more digits than necessary to avoid losing
  ! the last few bits in the decimal to binary conversion
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  !
  ! Local ---
  integer :: i,j,m,l
  real(4) :: kw,kx
  !
  do j=1,n
    corr(j) = 0.0
  enddo
  m = n/2+1
  kw = 0.01 * pi / m
  l = 2*bias+1
  do i=1,l
    if (buff(i).ne.0.0) then
      kx  = kw*(float(i)-bias)
      do j=1,n
        corr(j) = corr(j) + buff(i) * cos(kx*float(j-m))
      enddo
    endif
  enddo
end subroutine grdtab
!
subroutine retocm(r,z,nx,ny)
  !------------------------------------------------------------------------
  ! @  public
  !
  ! IMAGER -- FFT support routine
  !
  !   Convert real to complex, with Shifting in corners for FFT
  !!
  !------------------------------------------------------------------------
  integer, intent(in) :: nx, ny         !! Problem size
  real, intent(in) :: r(nx,ny)          !! Real values
  complex, intent(out) :: z(nx, ny)     !! Complex shifted values
  !
  ! Local ---
  integer :: i, j, ii, jj
  !
  ! Code ----
  do j=1, ny
    jj = mod(j+ny/2-1,ny)+1
    do i=1, nx
      ii = mod(i+nx/2-1,nx)+1
      z(ii,jj) = cmplx(r(i,j),0.0)
    enddo
  enddo
end subroutine retocm
!
subroutine cmtore (in,out,nx,ny)
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER -- FFT support routine
  !
  !   Extract Real image from Fourier Transform of its complex FFT
  !   with appropriate recentering
  !!
  !----------------------------------------------------------------------
  integer, intent(in) :: nx         !! Size of map
  integer, intent(in) :: ny         !! Size of map
  complex, intent(in) :: in(nx,ny)  !! Complex FFT
  real, intent(out) :: out(nx,ny)   !! Extracted real image
  !
  ! Local ---
  integer :: mx,my,i,j
  !
  ! Code ----
  mx = nx/2
  my = ny/2
  do j=1,my
    do i=1,mx
      out(i+mx,j+my) = real(in(i,j))
    enddo
    do i=1,mx
      out(i,j+my) = real(in(i+mx,j))
    enddo
  enddo
  do j=1,my
    do i=1,mx
      out(i+mx,j) = real(in(i,j+my))
    enddo
    do i=1,mx
      out(i,j) = real(in(i+mx,j+my))
    enddo
  enddo
end subroutine cmtore
!
subroutine convfn (ctype, parm, buffer, bias)
  use gkernel_interfaces
  use gildas_def
  use gbl_message
  !----------------------------------------------------------------------
  ! @ public-mandatory
  !
  ! IMAGER -- Gridding routine
  !
  !   CONVFN computes the convolving functions and stores them in
  !   the supplied buffer. Values are tabulated every 1/100 cell.
  !!
  !----------------------------------------------------------------------
  integer, intent(inout) :: ctype     !! Convolution type
  real(4), intent(inout) :: parm(10)  !! Convolution parameters
  real(4), intent(out)   :: buffer(:) !! Sampled values
  real(4), intent(out)   :: bias      !! Center of samples
  !
  real(4), parameter :: pi=3.1415926536
  !
  ! Local ---
  integer :: lim, i, im, ialf, ier, ibias, mbuf
  real(4) :: p1, p2, u, umax, absu, eta, psi
  !
  ! Code ----
  !
  ! Number of elements
  i = max (1, ceiling(parm(1))) ! Ensure at least one cell
  i = i * 2 + 1
  lim = i * 100 + 1
  !
  mbuf = ubound(buffer,1)
  if (lim.gt.mbuf) then
    Print *,'MBUF ',lim, mbuf
    call gag_message(seve%f,'GRID','Work buffer insufficient')
    call sysexi(fatale)
  endif
  bias = 50.0 * i + 1.0
  umax = parm(1)                ! Compute to that cell fraction
  !
  !  Check function types.
  if (ctype.lt.1 .or. ctype.gt.5) then
    !
    ! Type defaulted or not implemented, use Default = EXP * SINC
    ctype = 4
    parm(1) = 3.0
    parm(2) = 1.55
    parm(3) = 2.52
    parm(4) = 2.00
  endif
  !
  buffer(:) = 0.0
  !
  select case(ctype)
  case(1)
    ! Pill box
    do i = 1,lim
      u = (i-bias) * 0.01
      absu = abs (u)
      if (absu.lt.umax) then
        buffer(i) = 1.0
      elseif (absu.eq.umax) then
        buffer(i) = 0.5
      else
        buffer(i) = 0.0
      endif
    enddo
    !
  case(2)
    ! Exponential function.
    p1 = 1.0 / parm(2)
    do i = 1,lim
      u = (i-bias) * 0.01
      absu = abs (u)
      if (absu.gt.umax) then
        buffer(i) = 0.0
      else
        buffer(i) = exp (-((p1*absu) ** parm(3)))
      endif
    enddo
    !
  case(3)
    ! Sinc function.
    p1 = pi / parm(2)
    do i = 1,lim
      u = (i-bias)*0.01
      absu = abs (u)
      if (absu.gt.umax) then
        buffer(i) = 0.0
      elseif (absu.eq.0.0) then
        buffer(i) = 1.0
      else
        buffer(i) = sin (p1*absu) / (p1*absu)
      endif
    enddo
    !
  case(4)
    ! EXP * SINC convolving function
    p1 = pi / parm(2)
    p2 = 1.0 / parm(3)
    do i = 1,lim
      u = (i-bias)*0.01
      absu = abs (u)
      if (absu.gt.umax) then
        buffer(i) = 0.0
      elseif (absu.lt.0.01) then
        buffer(i) = 1.0
      else
        buffer(i) = sin(u*p1) / (u*p1) *   &
       &        exp (-((absu * p2) ** parm(4)))
      endif
    enddo
    !
  case(5)
    ! Spheroidal functions
    ialf = 2.0 * parm(2) + 1.1
    im = 2.0 * parm(1) + 0.1
    ialf = max (1, min (5, ialf))
    im = max (4, min (8, im))
    lim = parm(1) * 100.0 + 0.1
    ibias = bias
    do i = 1,lim
      eta = float (i-1) / float (lim-1)
      call sphfn (ialf, im, 0, eta, psi, ier)
      buffer(ibias+i-1) = psi
    enddo
    lim = ibias-1
    do i = 1,lim
      buffer(ibias-i) = buffer(ibias+i)
    enddo
  end select
  !
end subroutine convfn
!
subroutine sphfn (ialf, im, iflag, eta, psi, ier)
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !
  !     SPHFN is a subroutine to evaluate rational approximations to se-
  !  lected zero-order spheroidal functions, psi(c,eta), which are, in a
  !  sense defined in VLA Scientific Memorandum No. 132, optimal for
  !  gridding interferometer data.  The approximations are taken from
  !  VLA Computer Memorandum No. 156.  The parameter c is related to the
  !  support width, m, of the convoluting function according to c=
  !  pi*m/2.  The parameter alpha determines a weight function in the
  !  definition of the criterion by which the function is optimal.
  !  SPHFN incorporates approximations to 25 of the spheroidal func-
  !  tions, corresponding to 5 choices of m (4, 5, 6, 7, or 8 cells)
  !  and 5 choices of the weighting exponent (0, 1/2, 1, 3/2, or 2).
  !
  !  Input:
  !    IALF    I*4   Selects the weighting exponent, alpha.  IALF =
  !                  1, 2, 3, 4, and 5 correspond, respectively, to
  !                  alpha = 0, 1/2, 1, 3/2, and 2.
  !    IM      I*4   Selects the support width m, (=IM) and, correspond-
  !                  ingly, the parameter c of the spheroidal function.
  !                  Only the choices 4, 5, 6, 7, and 8 are allowed.
  !    IFLAG   I*4   Chooses whether the spheroidal function itself, or
  !                  its Fourier transform, is to be approximated.  The
  !                  latter is appropriate for gridding, and the former
  !                  for the u-v plane convolution.  The two differ on-
  !                  by a factor (1-eta**2)**alpha.  IFLAG less than or
  !                  equal to zero chooses the function appropriate for
  !                  gridding, and IFLAG positive chooses its F.T.
  !    ETA     R*4   Eta, as the argument of the spheroidal function, is
  !                  a variable which ranges from 0 at the center of the
  !                  convoluting function to 1 at its edge (also from 0
  !                  at the center of the gridding correction function
  !                  to unity at the edge of the map).
  !
  !  Output:
  !    PSI      R*4  The function value which, on entry to the subrou-
  !                  tine, was to have been computed.
  !    IER      I*4  An error flag whose meaning is as follows:
  !                     IER = 0  =>  No evident problem.
  !                           1  =>  IALF is outside the allowed range.
  !                           2  =>  IM is outside of the allowed range.
  !                           3  =>  ETA is larger than 1 in absolute
  !                                     value.
  !                          12  =>  IALF and IM are out of bounds.
  !                          13  =>  IALF and ETA are both illegal.
  !                          23  =>  IM and ETA are both illegal.
  !                         123  =>  IALF, IM, and ETA all are illegal.
  !
  !---------------------------------------------------------------------
  integer(4), intent(in)  :: ialf     !! Exponent
  integer(4), intent(in)  :: im       !! Width of support
  integer(4), intent(in)  :: iflag    !! Gridding function
  real(4), intent(in)     :: eta      !! For spheroidals only
  real(4), intent(out)    :: psi      !! Result
  integer(4), intent(out) :: ier      !! Error code
  !
  character(len=message_length) :: mess
  integer(4) j
  real(4) alpha(5), eta2, x
  real(4) p4(5,5), q4(2,5), p5(7,5), q5(5), p6l(5,5), q6l(2,5),   &
     &    p6u(5,5), q6u(2,5), p7l(5,5), q7l(2,5), p7u(5,5),   &
     &    q7u(2,5), p8l(6,5), q8l(2,5), p8u(6,5), q8u(2,5)
  data alpha / 0., .5, 1., 1.5, 2. /
  data p4 /   &
     &    1.584774e-2, -1.269612e-1,  2.333851e-1, -1.636744e-1,   &
     &    5.014648e-2,  3.101855e-2, -1.641253e-1,  2.385500e-1,   &
     &    -1.417069e-1,  3.773226e-2,  5.007900e-2, -1.971357e-1,   &
     &    2.363775e-1, -1.215569e-1,  2.853104e-2,  7.201260e-2,   &
     &    -2.251580e-1,  2.293715e-1, -1.038359e-1,  2.174211e-2,   &
     &    9.585932e-2, -2.481381e-1,  2.194469e-1, -8.862132e-2,   &
     &    1.672243e-2 /
  data q4 /   &
     &    4.845581e-1,  7.457381e-2,  4.514531e-1,  6.458640e-2,   &
     &    4.228767e-1,  5.655715e-2,  3.978515e-1,  4.997164e-2,   &
     &    3.756999e-1,  4.448800e-2 /
  data p5 /   &
     &    3.722238e-3, -4.991683e-2,  1.658905e-1, -2.387240e-1,   &
     &    1.877469e-1, -8.159855e-2,  3.051959e-2,  8.182649e-3,   &
     &    -7.325459e-2,  1.945697e-1, -2.396387e-1,  1.667832e-1,   &
     &    -6.620786e-2,  2.224041e-2,  1.466325e-2, -9.858686e-2,   &
     &    2.180684e-1, -2.347118e-1,  1.464354e-1, -5.350728e-2,   &
     &    1.624782e-2,  2.314317e-2, -1.246383e-1,  2.362036e-1,   &
     &    -2.257366e-1,  1.275895e-1, -4.317874e-2,  1.193168e-2,   &
     &    3.346886e-2, -1.503778e-1,  2.492826e-1, -2.142055e-1,   &
     &    1.106482e-1, -3.486024e-2,  8.821107e-3 /
  data q5 /   &
     &    2.418820e-1,  2.291233e-1,  2.177793e-1,  2.075784e-1,   &
     &    1.983358e-1 /
  data p6l /   &
     &    5.613913e-2, -3.019847e-1,  6.256387e-1, -6.324887e-1,   &
     &    3.303194e-1,  6.843713e-2, -3.342119e-1,  6.302307e-1,   &
     &    -5.829747e-1,  2.765700e-1,  8.203343e-2, -3.644705e-1,   &
     &    6.278660e-1, -5.335581e-1,  2.312756e-1,  9.675562e-2,   &
     &    -3.922489e-1,  6.197133e-1, -4.857470e-1,  1.934013e-1,   &
     &    1.124069e-1, -4.172349e-1,  6.069622e-1, -4.405326e-1,   &
     &    1.618978e-1 /
  data q6l /   &
     &    9.077644e-1,  2.535284e-1,  8.626056e-1,  2.291400e-1,   &
     &    8.212018e-1,  2.078043e-1,  7.831755e-1,  1.890848e-1,   &
     &    7.481828e-1,  1.726085e-1 /
  data p6u /   &
     &    8.531865e-4, -1.616105e-2,  6.888533e-2, -1.109391e-1,   &
     &    7.747182e-2,  2.060760e-3, -2.558954e-2,  8.595213e-2,   &
     &    -1.170228e-1,  7.094106e-2,  4.028559e-3, -3.697768e-2,   &
     &    1.021332e-1, -1.201436e-1,  6.412774e-2,  6.887946e-3,   &
     &    -4.994202e-2,  1.168451e-1, -1.207733e-1,  5.744210e-2,   &
     &    1.071895e-2, -6.404749e-2,  1.297386e-1, -1.194208e-1,   &
     &    5.112822e-2 /
  data q6u /   &
     &    1.101270e+0,  3.858544e-1,  1.025431e+0,  3.337648e-1,   &
     &    9.599102e-1,  2.918724e-1,  9.025276e-1,  2.575336e-1,   &
     &    8.517470e-1,  2.289667e-1 /
  data p7l /   &
     &    2.460495e-2, -1.640964e-1,  4.340110e-1, -5.705516e-1,   &
     &    4.418614e-1,  3.070261e-2, -1.879546e-1,  4.565902e-1,   &
     &    -5.544891e-1,  3.892790e-1,  3.770526e-2, -2.121608e-1,   &
     &    4.746423e-1, -5.338058e-1,  3.417026e-1,  4.559398e-2,   &
     &    -2.362670e-1,  4.881998e-1, -5.098448e-1,  2.991635e-1,   &
     &    5.432500e-2, -2.598752e-1,  4.974791e-1, -4.837861e-1,   &
     &    2.614838e-1 /
  data q7l /   &
     &    1.124957e+0,  3.784976e-1,  1.075420e+0,  3.466086e-1,   &
     &    1.029374e+0,  3.181219e-1,  9.865496e-1,  2.926441e-1,   &
     &    9.466891e-1,  2.698218e-1 /
  data p7u /   &
     &    1.924318e-4, -5.044864e-3,  2.979803e-2, -6.660688e-2,   &
     &    6.792268e-2,  5.030909e-4, -8.639332e-3,  4.018472e-2,   &
     &    -7.595456e-2,  6.696215e-2,  1.059406e-3, -1.343605e-2,   &
     &    5.135360e-2, -8.386588e-2,  6.484517e-2,  1.941904e-3,   &
     &    -1.943727e-2,  6.288221e-2, -9.021607e-2,  6.193000e-2,   &
     &    3.224785e-3, -2.657664e-2,  7.438627e-2, -9.500554e-2,   &
     &    5.850884e-2 /
  data q7u /   &
     &    1.450730e+0,  6.578685e-1,  1.353872e+0,  5.724332e-1,   &
     &    1.269924e+0,  5.032139e-1,  1.196177e+0,  4.460948e-1,   &
     &    1.130719e+0,  3.982785e-1 /
  data p8l /   &
     &    1.378030e-2, -1.097846e-1,  3.625283e-1, -6.522477e-1,   &
     &    6.684458e-1, -4.703556e-1,  1.721632e-2, -1.274981e-1,   &
     &    3.917226e-1, -6.562264e-1,  6.305859e-1, -4.067119e-1,   &
     &    2.121871e-2, -1.461891e-1,  4.185427e-1, -6.543539e-1,   &
     &    5.904660e-1, -3.507098e-1,  2.580565e-2, -1.656048e-1,   &
     &    4.426283e-1, -6.473472e-1,  5.494752e-1, -3.018936e-1,   &
     &    3.098251e-2, -1.854823e-1,  4.637398e-1, -6.359482e-1,   &
     &    5.086794e-1, -2.595588e-1 /
  data q8l /   &
     &    1.076975e+0,  3.394154e-1,  1.036132e+0,  3.145673e-1,   &
     &    9.978025e-1,  2.920529e-1,  9.617584e-1,  2.715949e-1,   &
     &    9.278774e-1,  2.530051e-1 /
  data p8u /   &
     &    4.290460e-5, -1.508077e-3,  1.233763e-2, -4.091270e-2,   &
     &    6.547454e-2, -5.664203e-2,  1.201008e-4, -2.778372e-3,   &
     &    1.797999e-2, -5.055048e-2,  7.125083e-2, -5.469912e-2,   &
     &    2.698511e-4, -4.628815e-3,  2.470890e-2, -6.017759e-2,   &
     &    7.566434e-2, -5.202678e-2,  5.259595e-4, -7.144198e-3,   &
     &    3.238633e-2, -6.946769e-2,  7.873067e-2, -4.889490e-2,   &
     &    9.255826e-4, -1.038126e-2,  4.083176e-2, -7.815954e-2,   &
     &    8.054087e-2, -4.552077e-2 /
  data q8u /   &
     &    1.379457e+0,  5.786953e-1,  1.300303e+0,  5.135748e-1,   &
     &    1.230436e+0,  4.593779e-1,  1.168075e+0,  4.135871e-1,   &
     &    1.111893e+0,  3.744076e-1 /
  !
  ! Code ----
  ier = 0
  if (ialf.lt.1 .or. ialf.gt.5) ier = 1
  if (im.lt.4 .or. im.gt.8) ier = 2+10*ier
  if (abs(eta).gt.1.) ier = 3+10*ier
  if (ier.ne.0) then
    write(mess,*) 'Error ',ier
    call gag_message(seve%e,'SPHEROIDAL',mess)
    return
  endif
  eta2 = eta**2
  j = ialf
  !
  ! Support width = 4 cells:
  if (im.eq.4) then
    x = eta2-1.
    psi = (p4(1,j)+x*(p4(2,j)+x*(p4(3,j)+x*(p4(4,j)+x*p4(5,j)))))   &
     &      / (1.+x*(q4(1,j)+x*q4(2,j)))
    !
    ! Support width = 5 cells:
  elseif (im.eq.5) then
    x = eta2-1.
    psi = (p5(1,j)+x*(p5(2,j)+x*(p5(3,j)+x*(p5(4,j)+x*(p5(5,j)   &
     &      +x*(p5(6,j)+x*p5(7,j)))))))   &
     &      / (1.+x*q5(j))
    !
    ! Support width = 6 cells:
  elseif (im.eq.6) then
    if (abs(eta).le..75) then
      x = eta2-.5625
      psi = (p6l(1,j)+x*(p6l(2,j)+x*(p6l(3,j)+x*(p6l(4,j)   &
     &        +x*p6l(5,j))))) / (1.+x*(q6l(1,j)+x*q6l(2,j)))
    else
      x = eta2-1.
      psi = (p6u(1,j)+x*(p6u(2,j)+x*(p6u(3,j)+x*(p6u(4,j)   &
     &        +x*p6u(5,j))))) / (1.+x*(q6u(1,j)+x*q6u(2,j)))
    endif
    !
    ! Support width = 7 cells:
  elseif (im.eq.7) then
    if (abs(eta).le..775) then
      x = eta2-.600625
      psi = (p7l(1,j)+x*(p7l(2,j)+x*(p7l(3,j)+x*(p7l(4,j)   &
     &        +x*p7l(5,j))))) / (1.+x*(q7l(1,j)+x*q7l(2,j)))
    else
      x = eta2-1.
      psi = (p7u(1,j)+x*(p7u(2,j)+x*(p7u(3,j)+x*(p7u(4,j)   &
     &        +x*p7u(5,j))))) / (1.+x*(q7u(1,j)+x*q7u(2,j)))
    endif
    !
    ! Support width = 8 cells:
  elseif (im.eq.8) then
    if (abs(eta).le..775) then
      x = eta2-.600625
      psi = (p8l(1,j)+x*(p8l(2,j)+x*(p8l(3,j)+x*(p8l(4,j)   &
     &        +x*(p8l(5,j)+x*p8l(6,j)))))) / (1.+x*(q8l(1,j)+x*q8l(2,j)))
    else
      x = eta2-1.
      psi = (p8u(1,j)+x*(p8u(2,j)+x*(p8u(3,j)+x*(p8u(4,j)   &
     &        +x*(p8u(5,j)+x*p8u(6,j)))))) / (1.+x*(q8u(1,j)+x*q8u(2,j)))
    endif
  endif
  !
  ! Normal return:
  if (iflag.gt.0 .or. ialf.eq.1 .or. eta.eq.0.) return
  if (abs(eta).eq.1.) then
    psi = 0.0
  else
    psi = (1.-eta2)**alpha(ialf)*psi
  endif
end subroutine sphfn
!
subroutine grdflt (ctypx, ctypy, xparm, yparm)
  !----------------------------------------------------------------------
  ! @ public
  !
  ! IMAGER -- Gridding function
  !
  !     GRDFLT determines default parameters for the convolution functions
  !     If no convolving type is chosen, an Spheroidal is picked.
  !     Otherwise any unspecified values ( = 0.0) will be set to some
  !     value.
  ! Arguments:
  !     CTYPX,CTYPY           I  Convolution types for X and Y direction
  !                                1 = pill box
  !                                2 = exponential
  !                                3 = sinc
  !                                4 = expontntial * sinc
  !                                5 = spheroidal function
  !     XPARM(10),YPARM(10)   R*4  Parameters for the convolution fns.
  !                                (1) = support radius (cells)
  !
  !----------------------------------------------------------------------
  integer, intent(inout) :: ctypx,ctypy !! Function type
  real(4), intent(inout) :: xparm(10)   !! X function parameters
  real(4), intent(inout) :: yparm(10)   !! Y function parameters
  !
  ! Constants
  character(len=12) chtyps(5)   !! Function types
  integer numprm(5)             !! Number of parameters
  data numprm /1, 3, 2, 4, 2/
  data chtyps /'Pillbox','Exponential','Sin(X)/(X)',   &
     &    'Exp*Sinc','Spheroidal'/
  !
  integer :: i
  !
  ! Code ---
  !
  ! Default = type 5
  if ((ctypx.le.0) .or. (ctypx.gt.5)) ctypx = 5
  !
  ! Pillbox
  if (ctypx.eq.1) then
    if (xparm(1).le.0.0) xparm(1) = 0.5
  elseif (ctypx.eq.2) then
    ! Exponential.
    if (xparm(1).le.0.0) xparm(1) = 3.0
    if (xparm(2).le.0.0) xparm(2) = 1.00
    if (xparm(3).le.0.0) xparm(3) = 2.00
  elseif (ctypx.eq.3) then
    ! Sinc.
    if (xparm(1).le.0.0) xparm(1) = 3.0
    if (xparm(2).le.0.0) xparm(2) = 1.14
  elseif (ctypx.eq.4) then
    ! Exponential * sinc
    if (xparm(1).le.0.0) xparm(1) = 3.0
    if (xparm(2).le.0.0) xparm(2) = 1.55
    if (xparm(3).le.0.0) xparm(3) = 2.52
    if (xparm(4).le.0.0) xparm(4) = 2.00
  else
    ! Spheroidal function
    if (xparm(1).le.0.0) xparm(1) = 3.0
    if (xparm(2).le.0.0) xparm(2) = 1.0
  endif
  !
  ! Put default cheking here for further function types

  ! Check Y convolution defaults
  if (ctypy.le.0) then
    ! Use X values
    ctypy = ctypx
    do i = 1,10
      yparm(i) = xparm(i)
    enddo
  elseif (ctypy.eq.1) then
    ! Pillbox
    if (yparm(1).le.0.0) yparm(1) = 0.5
  elseif (ctypy.eq.2) then
    ! Exponential
    if (yparm(1).le.0.0) yparm(1) = 3.0
    if (yparm(2).le.0.0) yparm(2) = 1.0
    if (yparm(3).le.0.0) yparm(3) = 2.0
  elseif (ctypy.eq.3) then
    ! Sinc
    if (yparm(1).le.0.0) yparm(1) = 3.0
    if (yparm(2).le.0.0) yparm(2) = 1.14
  elseif (ctypy.eq.4) then
    ! Exponential * sinc
    if (yparm(1).le.0.0) yparm(1) = 3.0
    if (yparm(2).le.0.0) yparm(2) = 1.55
    if (yparm(3).le.0.0) yparm(3) = 2.52
    if (yparm(4).le.0.0) yparm(4) = 2.00
  else
    ! Spheroidal function
    if (yparm(1).le.0.0) yparm(1) = 3.0
    if (yparm(2).le.0.0) yparm(2) = 1.0
  endif
  !
  ! Put default checking for new types here.
  ! Print parameters chosen.
  !      WRITE(6,1001) 'X',CHTYPS(CTYPX),(XPARM(K),K=1,NUMPRM(CTYPX))
  !      WRITE(6,1001) 'Y',CHTYPS(CTYPY),(YPARM(K),K=1,NUMPRM(CTYPY))
  !1001  FORMAT(1X,A,' Convolution ',A,' Par.=',5F8.4)
end subroutine grdflt
!
subroutine uvgmax(huv,visi,uvmax,uvmin)
  use image_def
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER -- Support for UV_MAP
  !
  !       Get the Min Max of UV distances
  !!
  !----------------------------------------------------------------------
  type (gildas), intent(inout) :: huv   !! UV data header
  real, intent(in) ::  visi(:,:)        !! Visibilities
  real, intent(out) :: uvmax            !! Max baseline
  real, intent(out) :: uvmin            !! Min baseline
  !
  ! Local ---
  integer :: j
  real(4) :: v
  !
  ! Code ----
  if (huv%gil%basemax.eq.0) then
    uvmax = 0.0
    uvmin = 1e36
    do j=1,huv%gil%nvisi        ! Consider only valid visibilities
      if (visi(6,j).gt.0) then  ! Avoid Null or Negative antenna numbers
        v = visi(1,j)*visi(1,j)+visi(2,j)*visi(2,j)
        if (v.ne.0) then
          uvmax = max(uvmax,v)
          uvmin = min(uvmin,v)
        endif
      endif
    enddo
    if (uvmin.gt.uvmax) uvmin = uvmax
    huv%gil%basemax = sqrt(uvmax)
    huv%gil%basemin = sqrt(uvmin)
  endif
  !
  uvmax = huv%gil%basemax
  uvmin = huv%gil%basemin
end subroutine uvgmax
!
function sump(n,a)
  !----------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER --  Support for UV_MAP
  !
  !       Return the sum of positive values in array
  !!
  !----------------------------------------------------------------------
  real :: sump               !! Return value, intent(out)
  integer, intent(in) :: n   !! Number of values
  real, intent(in) :: a(n)   !! Values
  !
  ! Local ---
  integer :: i
  real(kind=8) :: sumd    ! use extended precision to avoid losses
  !
  ! Code ----
  sumd = 0.0
  do i=1,n
    if (a(i).gt.0) sumd = sumd+a(i)
  enddo
  sump = sumd
end function sump
!
