subroutine mx_uvmap (u,b,m,grid,mapu,mapv,work,sblock,cpu0,rms)
  use gildas_def
  use image_def
  use gbl_format
  use gkernel_interfaces
  use mapping_interfaces
  use mx_parameters
  !---------------------------------------------------------------------
  ! MX:
  ! UVMAP Compute a map from a CLIC UV Sorted Table
  ! by Gridding and Fast Fourier Transform, with
  ! one single beam for all channels.
  !
  ! Input : (in X)
  ! a precessed UV table, sorted in V, ordered in
  ! (U,V,W,D,T,iant,jant,nchan(real,imag,weig))
  ! Output :
  ! a beam image (in B)
  ! a VLM cube   (in Y)
  ! Work space :
  ! a  VLM complex Fourier cube (first V value is for beam)
  ! a  complex plane
  ! Save results
  ! The grid correction GRID
  ! The UV coordinates  MAPU, MAPV
  ! The UV weight array WE_ADDR
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: u,b,m    !
  real :: grid(map_size(1),map_size(2))   !
  real :: mapu(map_size(1))                         !
  real :: mapv(map_size(2))                         !
  real :: work(*)                         !
  integer(4) :: sblock                    !
  real :: cpu0                            !
  real :: rms                             !
  ! Global
  type(gildas) :: uin
  ! Local
  real, allocatable :: natural_weight(:)  !
  complex, allocatable :: ipf(:,:)        ! Local FFT work space
  real, allocatable :: ipxc(:), ipyc(:)   ! Coordinate buffers
  integer :: ier, ns, j
  !
  ! in Module... ! real(8) :: freq
  real(8), parameter :: clight=299792458d-6  ! Frequency in MHz
  integer :: nx,ny,nc,nv,ctypx,ctypy, ndim, nn(2)
  real :: cpu1
  real :: xparm(10),yparm(10),null_taper(4)
  real :: vref,voff,vinc,uvmax,uvmin,wall
  real(kind=4) :: loff,boff
  real(8) :: dcol
  logical :: error
  integer :: icol, nvs
  integer :: i,nblock,iblock,kz,istart
  character(len=80) :: name,chain
  !
  data xparm/10*0/, yparm/10*0/, null_taper/4*0.0/
  !------------------------------------------------------------------------
  ! Code:
  nx = map_size(1)
  ny = map_size(2)
  !
  ! Input file
  name = uv_table
  call gildas_null(uin, type='UVT')
  call gdf_read_gildas (uin,name,'.uvt',error, data=.false.)
  if (error) then
    call gagout('F-MX_UVMAP,  Cannot read input UV table')
    goto 999
  endif
  !
  ! Get work space, ideally before mapping first image, for
  ! memory contiguity reasons.
  nv = uin%gil%dim(2)
  nc = uin%gil%nchan
  allocate (natural_weight(nv), weight(nv), vcoor(nv), stat=ier)
  print *,'Allocate Ier ',ier
  if (ier.ne.0) goto 999
  !
  ier = gdf_range(mcol,nc)
  print *,'Gdf_range ier ',ier
  if (ier.ne.0) goto 999
  if (wcol.eq.0) then
    wcol = (mcol(1)+mcol(2))/3
  endif
  wcol = max(1,wcol)
  wcol = min(wcol,nc)
  nc = mcol(2)-mcol(1)+1
  !
  ! Copy UV data set to MX data set: extract the planes to be imaged ?
  call mx_uvsort (u,uin,uv_table,new,shift,uvmax,uvmin,error)
  if (error) then
    call gagout('F-MX_UVMAP,  Cannot sort input UV table')
    goto 999
  endif
  Print *,'Done mx_uvsort'
  !
  vref = u%gil%ref(1)
  voff = u%gil%voff
  vinc = u%gil%vres
  icol = u%gil%fcol-1+u%gil%natom*wcol
  !
  ! Compute observing sky frequency for U,V cell size
  dcol = (mcol(1)+mcol(2))*0.5d0
  freq = gdf_uv_frequency(u,dcol)
  !
  ! Now create Complex VLM work cube
  call gag_cpu(cpu1)
  write(chain,1001) 'I-MX_UVMAP,  Start gridding ',cpu1-cpu0
  call gagout(chain)
  !
  ! Compute gridding function
  ctypx = ctype
  ctypy = ctype
  call grdflt (ctypx, ctypy, xparm, yparm)
  call convfn (ctypx, xparm, conv%ubuff, conv%ubias)
  call convfn (ctypy, yparm, conv%vbuff, conv%vbias)
  Print *,'MAP_CELL ',map_cell
  Print *,'MAP_SIZE ',map_size
  uv_cell(1) = clight/freq/(map_cell(1)*map_size(1))
  uv_cell(2) = clight/freq/(map_cell(2)*map_size(2))
  support(1) = xparm(1)*uv_cell(1) ! In meters
  support(2) = yparm(1)*uv_cell(2) ! In meters
  Print *,'UV_CELL ',uv_cell,freq,clight
  !
  call docoor (nx,-uv_cell(1),mapu)
  call docoor (ny,uv_cell(2),mapv)
  !
  if (sblock.gt.0) then
    ns = min(nc,sblock) + 1
  else
    ns = nc+1
  endif
  allocate (map_tf(ns,nx,ny),stat=ier)
  if (ier.ne.0) goto 999
  !
  nvs = u%gil%dim(1)
  call dovisi (nvs,nv,   &    ! Size of visibility array
     &    u%r2d,    &     ! Visibilities
     &    vcoor ,   &     ! V values
     &    natural_weight, icol)
  wall = sump(nv,natural_weight)
  if (wall.eq.0.0) then
    write(chain,'(A,I3,A)')   &
     &      'E-MX,  Plane ',wcol,' has zero weight'
    call gagout(chain)
    call sysexi(fatale)
  endif
  !
  ! Compute weights
  call doweig (nvs,nv,   &
     &    u%r2d,  &            ! Visibilities
     &    1,2,    &            ! U, V pointers
     &    wcol,   &            ! Weight channel
     &    uniform(1),   &      ! Uniform UV cell size
     &    weight, &            ! Weight array
     &    uniform(2),   &      ! % of uniformity
     &    vcoor,  &            ! V values
     &    error)               !
  if (error)  goto 999
  !
  ! Apply taper
  call dotape (nvs,nv,   &
     &    u%r2d,   &           ! Visibilities
     &    1,2,     &           ! U, V pointers
     &    uv_taper,   &        ! Taper
     &    weight)              ! Weight array
  wall = 1e-3/sqrt(wall)
  call prnoise('MX_UVMAP','Natural',wall,rms)  ! RMS is a scaling factor
  !
  ! Re-normalize the weights and re-count the noise
  call scawei (nv,weight,natural_weight,wall)
  wall = 1e-3/sqrt(wall)
  call prnoise('MX_UVMAP','Expected',wall,rms)
  rms = wall                   ! This is the RMS in Jy/Beam
  !
  ! Compute FFT's
  if (sblock.gt.0) then
    nblock = (nc+sblock-1)/sblock
    kz = min (sblock,nc)
  else
    kz = nc
  endif
  call dofft (nvs,nv,   & ! Size of visibility array
     &    u%r2d,                 &     ! Visibilities
     &    1,2,   &             ! U, V pointers
     &    mcol(1),   &         ! First channel to map
     &    kz,nx,ny,   &        ! Cube size
     &    map_tf,        &     ! FFT cube
     &    mapu,mapv,   &       ! U and V grid coordinates
     &    support,uv_cell,null_taper,   &  ! Gridding parameters
     &    weight, vcoor,  &     ! Weight array
     &    conv%ubias,conv%vbias,conv%ubuff,conv%vbuff,ctype)
  !
  ! Do not free visibilities
  call gag_cpu(cpu1)
  write(chain,1001) 'I-MX_UVMAP,  Finished gridding ',cpu1-cpu0
  call gagout(chain)
  allocate (ipf(nx,ny), stat=ier)  ! Get work space for FFTs
  if (ier.ne.0) goto 999
  !
  ! Make beam, not normalized
  ndim = 2
  nn(1) = nx
  nn(2) = ny
  !
  call gildas_null(b, type= 'IMAGE')
  call gdf_copy_header (u, b, error)
  b%gil%proj_words = 0
  b%gil%extr_words = 0
  b%gil%ndim = 2
  b%gil%dim(1) = nx
  b%gil%dim(2) = ny
  b%gil%dim(3) = 1
  b%gil%dim(4) = 1
  b%gil%ref(1) = nx/2+1
  b%gil%ref(2) = ny/2+1
  b%gil%val(1) = 0
  b%gil%val(2) = 0
  b%gil%inc(1) = -map_cell(1)        ! Assume EQUATORIAL system
  b%gil%inc(2) = map_cell(2)
  name  = map_name
  call sic_parsef(name,b%file,' ','.beam')
  call gagout('I-MX_UVMAP,  Creating beam file '   &
     &    //b%file(1:lenc(b%file)))
  call gdf_create_image(b, error)
  if (error) then
    call gagout('F-MX_UVMAP,  Cannot create beam image')
    goto 999
  endif
  call extrac (kz+1,nx,ny,kz+1,map_tf, ipf)
  call fourt  (ipf,nn,ndim,-1,1,work)
  allocate (b%r2d(nx,ny), stat=ier)
  call cmtore (ipf,b%r2d,nx,ny)
  !
  ! Compute grid correction,
  ! Normalization factor is applied to grid correction, for further
  ! use on channel maps. Use IPF for work space.
  !
  allocate (ipxc(nx), ipyc(ny), stat=ier)
  call grdtab (ny, conv%vbuff, conv%vbias, ipyc)
  call grdtab (nx, conv%ubuff, conv%ubias, ipxc)
  call dogrid (grid,ipxc,ipyc,nx,ny,b%r2d)
  !
  ! Normalize and Update beam
  call docorr (b%r2d,grid,nx*ny)
  call gag_cpu(cpu1)
  write(chain,1001) 'I-MX_UVMAP,  Finished beam ',cpu1-cpu0
  call gagout(chain)
  !
  ! Create image (in order l m v )
  name  = map_name
  call gildas_null(m, type= 'IMAGE')
  call gdf_copy_header (b, m, error)
  call sic_parsef(name,m%file,' ','.lmv-res')
  call gagout('I-MX_UVMAP,  Creating map file '   &
     &    //m%file(1:lenc(m%file)))
  !
  m%gil%ndim = 3
  m%gil%dim(1) = nx
  m%gil%dim(2) = ny
  m%gil%dim(3) = nc
  m%gil%dim(4) = 1
  m%gil%ref(3) = vref-mcol(1)+1
  m%gil%val(3) = voff
  m%gil%inc(3) = vinc
  ! Projection information (assume equatorial system)
  m%gil%posi_words = 12
  m%gil%proj_words = 9
  m%gil%extr_words = 0                   ! extrema not computed
  m%char%code(1) = 'RA'
  m%char%code(2) = 'DEC'
  m%char%code(3) = 'VELOCITY'
  call equ_to_gal(m%gil%ra,m%gil%dec,0.0,0.0,m%gil%epoc,  &
                  m%gil%lii,m%gil%bii,loff,boff,error)
  m%gil%ptyp = p_azimuthal                   ! Azimuthal (Sin)
  m%char%syst = 'EQUATORIAL'
  m%gil%xaxi = 1
  m%gil%yaxi = 2
  m%gil%faxi = 3
  m%char%unit = 'Jy/beam'
  !
  call gdf_create_image (m,error)
  if (error) then
    call gagout('F-MX_UVMAP,  Cannot create output LMV image')
    goto 999
  endif
  !
  allocate (m%r3d(nx,ny,nc), stat=ier)
  !
  ! Make maps with grid correction
  do i=1,kz
    call extrac (kz+1,nx,ny,i,map_tf, ipf)
    call fourt  (ipf,nn,ndim,-1,1,work)
    call cmtore (ipf,m%r3d(:,:,i),nx,ny)
    call docorr (m%r3d(:,:,i),grid,nx*ny)
  enddo
  j = kz
  !
  ! Proceed with further planes
  if (kz.lt.nc) then
    do iblock = 2,nblock
      istart = mcol(1)+(iblock-1)*sblock
      kz = min (sblock,nc-sblock*(iblock-1))
      call dofft (nvs,nv,   & ! Size of visibility array
     &        u%r2d,        & ! Visibilities
     &        1,2,   &         ! U, V pointers
     &        istart,   &      ! First channel to map
     &        kz,nx,ny,   &    ! Cube size
     &        map_tf,   & ! FFT cube
     &        mapu,mapv,   &   ! U and V grid coordinates
     &        support,uv_cell,null_taper,   &  ! Gridding parameters
     &        weight, vcoor,  &    ! Weight array
     &        conv%ubias,conv%vbias,conv%ubuff,conv%vbuff,ctype)
      !
      do i=1,kz
        j = j+1
        call extrac (kz+1,nx,ny,i,map_tf,ipf)
        call fourt  (ipf,nn,ndim,-1,1,work)
        call cmtore (ipf,m%r3d(:,:,j),nx,ny)
        call docorr (m%r3d(:,:,j),grid,nx*ny)
      enddo
    enddo
  endif
  !
  call gag_cpu(cpu1)
  write(chain,1001) 'I-MX_UVMAP,  Finished maps CPU ',cpu1-cpu0
  call gagout(chain)
  !
  ! Delete scratch space
  return
  !
  999   call sysexi(fatale)
  1001  format(a,f11.2)
end subroutine mx_uvmap
