
subroutine many_beams_para (rname,map,channels,huv,hbeam,hdirty,   &
     &    nx,ny,nu,nv,uvdata,   &
     &    r_weight, do_weig,    &
     &    sblock,cpu0,error,uvmax,jfield,abort,cthread)
  use gkernel_interfaces
  use imager_interfaces, except_this=>many_beams_para
  use clean_def
  use image_def
  use gbl_message
  !$ use omp_lib
  !------------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for UV_MAP  
  !   Compute a map from a CLIC UV Sorted Table
  !   by Gridding and Fast Fourier Transform, with
  !   a different beam per channel.
  !
  ! Input :  
  ! a precessed UV table, sorted in V, ordered in
  ! (U,V,W,D,T,iant,jant,nchan(real,imag,weig))
  !
  ! Output :  
  ! a beam image  
  ! a VLM cube  
  !
  ! Work space :  
  ! a  VLM complex Fourier cube (first V value is for beam)
  !!
  !------------------------------------------------------------------------
  character(len=*), intent(in) :: rname     !! Caller name
  type (uvmap_par), intent(inout) :: map    !! Mapping parameters
  type (channel_par), intent(inout) :: channels   !! Control of range & beam
  type (gildas), intent(inout) :: huv       !! UV data set header
  type (gildas), intent(inout) :: hbeam     !! Dirty beam data set
  type (gildas), intent(inout) :: hdirty    !! Dirty image data set
  integer, intent(in) :: nx     !! X size
  integer, intent(in) :: ny     !! Y size
  integer, intent(in) :: nu     !! Size of a visibility
  integer, intent(in) :: nv     !! Number of visibilities
  real, intent(in) :: uvdata(nu,nv)  !! Visibilities
  real, intent(inout), target :: r_weight(nv)      !! Weight of visibilities
  logical, intent(inout) :: do_weig  !! Compute weights ? 
  integer, intent(in) :: jfield      !! Field number (for mosaic)
  real, intent(inout) :: cpu0        !! Running CPU time
  real, intent(inout) :: uvmax       !! Maximum baseline
  integer, intent(inout) :: sblock   !! Blocking factor (in visibilities)
  logical, intent(inout) :: error    !! Logical error flag
  logical, intent(inout) :: abort    !! User Abort flag
  integer, intent(in)    :: cthread  !! Calling Thread number for bookeeping
  ! 
  ! Constants
  real(kind=8), parameter :: clight=299792458d-6 ! Frequency in  MHz
  !
  ! Local ---
  type (gridding) :: conv   ! Gridding convolution control
  integer :: nc   ! Number of channels
  integer :: nd   ! Size of data
  integer :: nb   ! Number of beams
  integer :: ns   ! Number of channels per single beam
  integer :: wcol     ! Weight channel
  integer :: mcol(2)  ! First and last channel
  integer :: lcol,fcol,ier
  real(kind=8) :: freq
  integer ctypx,ctypy
  real wall,cpu1
  real xparm(10),yparm(10)
  real(8) :: vref,voff,vinc
  integer ndim, nn(2), lx, ly, kz1
  integer kz,iz,ic,kc,kb,jc,lc
  character(len=message_length) :: chain
  !
  real :: rms, null_taper(4), wold
  complex, allocatable :: ftbeam(:,:)
  complex, allocatable :: tfgrid(:,:,:)
  real, allocatable :: w_xgrid(:),w_ygrid(:), w_w(:),  w_grid(:,:), walls(:)
  real, allocatable :: w_weight(:)
  real, allocatable :: w_v(:)         ! V values
  real, allocatable :: beam(:,:)
  real, allocatable :: w_mapu(:), w_mapv(:)
  real, allocatable :: local_wfft(:)
  real uvcell(2)
  real support(2)
  real(8) local_freq
  !
  integer :: ithread, nthread
  real(8) :: elapsed_s, elapsed_e, elapsed
  !
  real :: toto
  logical :: local_error
  integer :: grid_code
  !
  ! Code ----
  call imager_tree('MANY_BEAMS_PARA in many_beams.f90',.false.)
  !
  ! Code:
  grid_code = 0
  error = .false.
  abort = .false.
  nd = nx*ny
  nc = huv%gil%nchan
  nb = hbeam%gil%dim(3)
  !
  ns = map%beam
  null_taper = 0
  !
  if (ns.ne.1 .and. nb.gt.1) then
    write(chain,'(a,i6,a)') 'Processing ',ns,' channels per beam'
    call map_message(seve%w,rname,chain)
  endif
  !
  ! Reset the parameters
  xparm = 0.0
  yparm = 0.0
  !
  vref = huv%gil%ref(1)
  voff = huv%gil%voff
  vinc = huv%gil%vres
  !
  ! Channel range and Weight
  mcol = channels%bounds
  wcol = channels%weight 
  fcol = channels%bounds(1)
  lcol = channels%bounds(2)
  nc = lcol-fcol+1
  !
  ! Compute observing sky frequency for U,V cell size
  if (channels%freq.ne.0) then
    freq = gdf_uv_frequency(huv, channels%freq)
  else
    freq = gdf_uv_frequency(huv)
  endif
  !
  ! Compute gridding function
  ctypx = map%ctype
  ctypy = map%ctype
  call grdflt (ctypx, ctypy, xparm, yparm)
  call convfn (ctypx, xparm, conv%ubuff, conv%ubias)
  call convfn (ctypy, yparm, conv%vbuff, conv%vbias)
  map%uvcell = clight/freq/(map%xycell*map%size)
  map%support(1) = xparm(1)*map%uvcell(1)  ! In meters
  map%support(2) = yparm(1)*map%uvcell(2)
  !
  ! Process sorted UV Table according to the type of beam produced
  !
  allocate (w_w(nv),w_v(nv),w_weight(nv),walls(nb),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Cannot allocate Weight & V arrays')
    error = .true.
    return
  endif
  w_v(:) = uvdata(2,1:nv)
  !
  !
  lx = (uvmax+map%support(1))/map%uvcell(1) + 2
  ly = (uvmax+map%support(2))/map%uvcell(2) + 2
  lx = 2*lx
  ly = 2*ly
  if (ly.gt.ny) then
    write(chain,'(A,A,F8.3)') 'Map cell is too large ',   &
        &      ' Undersampling ratio ',float(ly)/float(ny)
    call map_message(seve%w,rname,chain,3)
    ly = min(ly,ny)
    lx = min(lx,nx)
  endif
  !
  ! Get FFTs and beam work spaces
  allocate (tfgrid(ns+1,lx,ly),ftbeam(nx,ny),beam(nx,ny),&
    & w_mapu(lx),w_mapv(ly),local_wfft(2*max(nx,ny)), &
    & w_xgrid(nx),w_ygrid(ny),w_grid(nx,ny),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Cannot allocate TF arrays')
    error = .true.
    return
  endif
  !
  call docoor (lx,-map%uvcell(1),w_mapu)
  call docoor (ly,map%uvcell(2),w_mapv)
  !
  ! Prepare grid correction,
  call grdtab (ny, conv%vbuff, conv%vbias, w_ygrid)
  call grdtab (nx, conv%ubuff, conv%ubias, w_xgrid)
  !
  ! Make beam, not normalized
  call uvmap_headers(huv,nx,ny,nb,ns,map,mcol,hbeam,hdirty,error)
  if (error) return
  if (sic_ctrlc()) then
    abort = .true. ! Quick abort
    return
  endif
  !
  ndim =2
  nn(1) = nx
  nn(2) = ny
  !
  nthread = 1
  if (nb.gt.1) then
    !$ nthread = ompget_inner_threads()
  endif
  !TEST!Print *,'MANY_BEAMS_PARA Thread ',nthread,' NB ',nb,' NS ',ns
  !
  ! Loop over blocks
  !
  !$OMP PARALLEL IF (nb.gt.1) DEFAULT(none) NUM_THREADS (nthread) &
  !$OMP PRIVATE(tfgrid,ftbeam,beam,w_weight,w_w) &  ! Big arrays
  !$OMP PRIVATE(w_mapu,w_mapv,w_grid) &
  !$OMP PRIVATE(local_wfft,chain) &
  !$OMP PRIVATE(local_freq,support,wall,wold,rms,uvcell,local_error) &
  !$OMP PRIVATE(kz,kb,kc,iz,ic, kz1, toto, jc,lc) &
  !$OMP SHARED(walls,ns,nb) &
  !$OMP SHARED(nu,nv,nx,ny,nc,nd,fcol,lcol,lx,ly, nthread) &
  !$OMP SHARED(map,null_taper,error,abort,grid_code) &
  !$OMP SHARED(conv,freq,do_weig, r_weight) &
  !$OMP SHARED(nn,ndim,huv,hbeam,hdirty,rname) &
  !$OMP SHARED(w_xgrid,w_ygrid,w_v,uvdata) &
  !$OMP SHARED(cpu0,cpu1) PRIVATE(elapsed_s, elapsed_e, elapsed, ithread)
  !
  kz = 1 ! test for bug below
  !
  !TEST!Print *,'KZ ',kz,' NC ',nc,' nd ',nd
  !$OMP DO
  do ic = fcol,lcol,ns ! ,ns or ,1
    if (sic_ctrlc()) abort = .true. ! Quick abort
    if (abort) cycle
    !
    kz = min(ns,lcol-ic+1)
    jc = min(huv%gil%nchan,ic+ns/3)   ! The default weight channel here...
    !TEST!Print *,'IC ',ic,' JC ',jc,'MCOL ',fcol,lcol,' NS ',ns
    ithread = 1
    !$ elapsed_s = omp_get_wtime()
    !$ ithread = omp_get_thread_num()+1
    !TEST!Print *,'Thread ',ithread,' IC ',ic,', KZ ',kz,', NS ',ns
    !
    kb = (ic-fcol)/ns+1
    if (kb.gt.nb .or. kb.lt.1) then
      Print *,'Programming error, expected 0 < ',kb,' < ',nb+1
      kb = nb
    endif
    !
    w_w(:) = uvdata(7+3*jc,:)
    wold = sump(nv,w_w)
    !
    ! Search for a non empty weight channel
    if (wold.eq.0) then
      do lc=ic,min(ic+ns,lcol) ! not  ,huv%gil%nchan)
        if (lc.ne.jc) then
          w_w(:) = uvdata(7+3*lc,:)
          wold = sump(nv,w_w)
          if (wold.ne.0) then
            jc = lc
            exit
          endif
        endif
      enddo
    endif
    !
    if (wold.eq.0) then
      write(chain,'(A,I6,A)') 'Channel ',jc, ' has zero weight'
      hbeam%r3d(:,:,kb) = 0
      hdirty%r3d(:,:,kb) = 0
      walls(kb) = 0.0
      if (nb.eq.1) then
        call map_message(seve%e,rname,chain)
        error = .true.
      else
        call map_message(seve%w,rname,chain)
      endif
      cycle
    else
      wall = 1e-3/sqrt(wold)
      !TEST!write(chain,'(a,i6,a)') 'Plane ',ic,' Natural '
      !TEST!call prnoise('UV_MAP',trim(chain),wall,rms)
      walls(kb) = wall
    endif
    !
    ! Compute the weights from this
    if (do_weig) then
      local_error = .false.
      call doweig (nu,nv,   &
         &    uvdata,   &          ! Visibilities
         &    1,2,    &            ! U, V pointers
         &    jc,     &            ! Weight channel
         &    map%uniform(1),   &  ! Uniform UV cell size
         &    w_weight,   &        ! Weight array
         &    map%uniform(2),   &  ! Fraction of weight
         &    local_error,      &
         &    grid_code)
         
      if (sic_ctrlc()) abort = .true. ! Quick abort
      if (abort) cycle
      if (local_error)  then
        error = .true.
        cycle
      endif
  !    Print *,ic,'doweig',w_v
  !    read(5,*) toto
      !
      ! Should also plug the TAPER here, rather than in DOFFT later  !
      call dotape (nu,nv,   &
         &    uvdata,   &          ! Visibilities
         &    1,2,   &             ! U, V pointers
         &    map%taper,  &        ! Taper
         &    w_weight)            ! Weight array
      if (sic_ctrlc()) abort = .true. ! Quick abort
      if (abort) cycle
    else
      call map_message(seve%i,rname,'Reusing weights')
      w_weight(:) = r_weight
    endif
    !
    ! Re-normalize the weights and re-count the noise
    wall = sump(nv,w_weight)
    if (wall.ne.wold) then
      call scawei (nv,w_weight,w_w,wall)
      wall = 1e-3/sqrt(wall)
      !TEST!write(chain,'(a,i6,a)') 'Plane ',ic,' Expected '
      !TEST!call prnoise('UV_MAP',trim(chain),wall,rms)
      walls(kb) = wall
    endif
    !
    ! Then compute the Dirty Beam
    local_freq = gdf_uv_frequency(huv, dble(ic))
    uvcell = map%uvcell * (freq / local_freq)
    support = map%support * (freq / local_freq)
    call docoor (lx,-uvcell(1),w_mapu)
    call docoor (ly,uvcell(2),w_mapv)
    !TEST!Print *,ic,'docoor'
    if (sic_ctrlc()) abort = .true. ! Quick abort
    if (abort) cycle
    !
    ! Compute FFTs
    call dofft (nu,nv,          &   ! Size of visibility array
         &    uvdata,           &   ! Visibilities
         &    1,2,              &   ! U, V pointers
         &    ic,               &   ! First channel to map
         &    kz,lx,ly,         &   ! Cube size
         &    tfgrid,           &   ! FFT cube
         &    w_mapu,w_mapv,    &   ! U and V grid coordinates
         &    support,uvcell,null_taper, &  ! Gridding parameters
         &    w_weight,         &    ! Weight array 
         &    conv%ubias,conv%vbias,conv%ubuff,conv%vbuff,map%ctype)
       !TEST!Print *,ic,'dofft'
    if (sic_ctrlc()) abort = .true. ! Quick abort
    if (abort) cycle
    !
    kz1 = kz+1
    call extracs(kz1,nx,ny,kz1,tfgrid,ftbeam,lx,ly)
    call fourt  (ftbeam, nn,ndim,-1,1,local_wfft)
    beam = 0.0
    call cmtore (ftbeam, beam ,nx,ny)
    call chkfft (beam, nx,ny, error)
    !TEST!   Print *,ic,'BEAM ',nx,ny,beam(nx/2+1,ny/2+1)
    !TEST!Print *,'NU,NV ',nu,nv
    !TEST!Print *,'IC ',ic
    !TEST!Print *,'KZ,LX,LY ',kz,lx,ly
    !TEST!Print *,'support ',support,' uvcell ',uvcell, ' null_taper ',null_taper
    !TEST!Print *,'conv%ubias,conv%vbias,map%ctype ',conv%ubias,conv%vbias,map%ctype
    !TEST!Print *, ' '
    if (error) then
      Print *,ic,'BEAM ',nx,ny,beam(nx/2+1,ny/2+1)
      Print *,'Local freq ',local_freq
      Print *,'KZ, LX, LY ', kz,lx,ly, ' nx,ny ',nx,ny, ' NS ',ns
      call gagout('E-UV_MAP,  Inconsistent pixel size')
!      read(5,*) ians
!      if (ians.eq.1) then
!        Print *,tfgrid(kz+1,:,ly/2)
!      endif
      cycle
    endif
    !
    ! Compute grid correction,
    ! Normalization factor is applied to grid correction, for further
    ! use on channel maps.
    !
    ! Make beam, not normalized
    call dogrid (w_grid,w_xgrid,w_ygrid,nx,ny,beam)  ! grid correction
    if (sic_ctrlc()) abort = .true. ! Quick abort
    if (abort) cycle
    !
    ! Normalize and Free beam
    call docorr (beam,w_grid,nx*ny)
       !TEST!Print *,ic,'docorr'
    !
    ! Write beam
    hbeam%r3d(:,:,kb) = beam
       !TEST!Print *,ic,'Done Beam ',kc,nc
    ! --- Done beam
    !
    ! Now extracts the Image planes...
    do iz=1,kz
      if (sic_ctrlc()) abort = .true. ! Quick abort
      if (abort) cycle
      call extracs(kz+1,nx,ny,iz,tfgrid,ftbeam,lx,ly)
      call fourt  (ftbeam,nn,ndim,-1,1,local_wfft)
      call cmtore (ftbeam,beam,nx,ny)
      call docorr (beam,w_grid,nd)
      ! Write the subset
      kc = ic-fcol+iz
      hdirty%r3d(:,:,kc) = beam
    enddo
    if (sic_ctrlc()) abort = .true. ! Quick abort
    if (abort) cycle
    !
    !$  elapsed_e = omp_get_wtime()
    elapsed = elapsed_e - elapsed_s
    write(chain,103) 'End plane ',kc,' Time ',elapsed &
      & ,' Thread ',ithread
    call map_message(seve%d,rname,chain)
    if (do_weig .and. nb.eq.1) then
      do_weig = .false.
      r_weight = w_weight
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
!TEST!  !$ if (nb.gt.1) call omp_set_num_threads(othread)
  if (error) return
  if (abort) return
  !
  call gag_cpu(cpu1)
  if (jfield.eq.0) then
    write(chain,102) 'Finished maps ',cpu1-cpu0
    call map_message(seve%i,rname,chain)
  endif
  !
  wall = maxval(walls(1:nb))
  if (jfield.eq.0) then
    chain = 'Expected'
  else
    write(chain,'(A,I0,A)') 'Field ',jfield,'; Expected'
  endif
  call prnoise(rname,trim(chain),wall,rms)
  hdirty%gil%noise = wall
  !  !
  ! Delete scratch space
  error = .false.
  if (nb.ne.1)  deallocate(w_grid)
  if (allocated(tfgrid)) deallocate(tfgrid)
  if (allocated(ftbeam)) deallocate(ftbeam)
  if (allocated(w_xgrid)) deallocate(w_xgrid)
  if (allocated(w_ygrid)) deallocate(w_ygrid)
  !
  call imager_tree('MANY_BEAMS_PARA',.true.)
  return
  !
102 format(a,f9.2)
103 format(a,i5,a,f9.2,a,i2,a,i2)
end subroutine many_beams_para
!
subroutine uv_grid_comm(line,comm,error)
  use clean_arrays
  use clean_default
  use gkernel_interfaces
  use imager_interfaces
  !! Test routine -- not yet used
  character(len=*), intent(in) :: comm
  character(len=*), intent(in) :: line
  logical, intent(out) :: error
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: sec_in_rad = pi/3600d0/180d0
  real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
  !
  logical :: abort
  type(channel_par) :: channels
  real :: cpu0
  character(len=16) :: task
  integer :: cthread=1 ! Not needed ?
  real(8) :: freq
  integer :: nu,nv,nx,ny
  real :: uvmin, uvmax,rmega
  integer :: sblock,ier
  !
  task = comm
  !
  error = .false.
  !
  call uvmap_cols(task,line,huv,channels,error)
  if (error) return 
  !
  call uvgmax (huv,duv,uvmax,uvmin)
  freq = gdf_uv_frequency(huv)
    Print *,'Doing map-parameters', freq, uvmin, uvmax
    Print *,'MAP ',themap%size, themap%field, themap%xycell
  uvmax = uvmax*(freq*f_to_k)
  uvmin = uvmin*(freq*f_to_k)
  call map_parameters(task,themap,huv,freq,uvmax,uvmin,error,.true.) ! huv%gil%majo)
  if (error) return
  uvmax = uvmax/(freq*f_to_k)
  themap%xycell = themap%xycell*pi/180.0/3600.0   ! Must be in Radian
  !
  nx = themap%size(1)
  ny = themap%size(2)
  nu = huv%gil%dim(1)
  nv = huv%gil%nvisi ! not %%dim(2)
  !
  rmega = 8.0
  ier = sic_ramlog('SPACE_IMAGER',rmega)
  sblock = max(int(256.0*rmega*1024.0)/(nx*ny),1)
  !
  Print *,'NX, NY ',nx,ny
  themap%ctype = 5
  call uv_grid_para (task,themap,channels,huv,hbeam,hdirty,   &
     &    nx,ny,nu,nv,duv,   &
!     &    r_weight, do_weig,    &
     &    sblock,cpu0,error,uvmax,1,abort,cthread)
  !
end subroutine uv_grid_comm
!
subroutine uv_grid_para (rname,map,channels,huv,hbeam,hdirty,   &
     &    nx,ny,nu,nv,uvdata,   &
!     &    r_weight, do_weig,    &
     &    sblock,cpu0,error,uvmax,jfield,abort,cthread)
  use gkernel_interfaces
  use imager_interfaces, except_this=>uv_grid_para
  use clean_def
  use image_def
  use gbl_message
  !$ use omp_lib
  !------------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for UV_MAP  
  !   Re-grid (normally huge) sorted UV table
  !   by Gridding and return the result as a new UV Table
  !
  ! Input :  
  ! a precessed UV table, sorted in V, ordered in
  ! (U,V,W,D,T,iant,jant,nchan(real,imag,weig))
  !
  ! Output :  
  ! a UV table, with no antenna numbers
  !
  ! Work space :  
  ! a  VLM complex Fourier cube (first V value is for beam)
  !!
  !------------------------------------------------------------------------
  character(len=*), intent(in) :: rname     !! Calling Task name
  type (uvmap_par), intent(inout) :: map    !! Mapping parameters
  type (channel_par), intent(inout) :: channels   !! Control of range & beam
  type (gildas), intent(inout) :: huv       !! UV data set
  type (gildas), intent(inout) :: hbeam     !! Dirty beam data set
  type (gildas), intent(inout) :: hdirty    !! Dirty image data set
  integer, intent(in) :: nx     !! X size
  integer, intent(in) :: ny     !! Y size
  integer, intent(in) :: nu     !! Size of a visibility
  integer, intent(in) :: nv     !! Number of visibilities
  real, intent(in) :: uvdata(nu,nv)  !! Visibilities
  integer, intent(in) :: jfield      !! Field number (for mosaic)
  real, intent(inout) :: cpu0        !! Running CPU counter
  real, intent(inout) :: uvmax       !! Maximum baseline
  integer, intent(inout) :: sblock   !! Blocking factor
  logical, intent(inout) :: error    !! Logical error flag
  logical, intent(inout) :: abort    !! User abort flag
  integer, intent(in)    :: cthread  !! Calling Thread number
  !
  ! Constants
  real(kind=8), parameter :: clight=299792458d-6 ! Frequency in  MHz
  !
  ! Local ---
  type (gridding) :: conv
  integer :: nc   ! Number of channels
  integer :: nd   ! Size of data
  integer :: nb   ! Number of beams
  integer :: ns   ! Number of channels per single beam
  integer :: wcol     ! Weight channel
  integer :: mcol(2)  ! First and last channel
  integer lcol,fcol
  integer ier
  real(kind=8) :: freq
  integer ctypx,ctypy
  real wall,cpu1
  real xparm(10),yparm(10)
  real(8) :: vref,voff,vinc
  integer :: lx, ly, kz1
  integer kz,iz,ic,kc,kb,jc,lc
  character(len=message_length) :: chain
  !
  real :: rms, null_taper(4), wold
  complex, allocatable :: tfgrid(:,:,:)
  real, allocatable :: w_weight(:), w_w(:), walls(:)
  real, allocatable :: w_v(:)         ! V values
  real, allocatable :: w_mapu(:), w_mapv(:)
  real, allocatable :: local_wfft(:)
  real :: uvcell(2)
  real :: support(2)
  real(8) :: local_freq
  !
  integer :: ithread, nthread
  real(8) :: elapsed_s, elapsed_e, elapsed
  !
  logical :: local_error
  integer :: grid_code
  !
  real, allocatable :: duv_grid(:,:)
  type(gildas) :: hgrid
  integer :: iv,ix,iy
  !
  ! Code ----
  call imager_tree('UV_GRID_PARA',.false.)
  !
  grid_code = 0
  error = .false.
  abort = .false.
  nd = nx*ny
  nc = huv%gil%nchan
  nb = 1 ! hbeam%gil%dim(3)
  !
  ns = map%beam
  Print *,'MAP%BEAM ',map%beam
  if (ns.eq.0) ns = nc !MODIF
  null_taper = 0
  !
  if (ns.ne.1 .and. nb.gt.1) then
    write(chain,'(a,i6,a)') 'Processing ',ns,' channels per beam'
    call map_message(seve%w,rname,chain)
  endif
  !
  ! Reset the parameters
  xparm = 0.0
  yparm = 0.0
  !
  vref = huv%gil%ref(1)
  voff = huv%gil%voff
  vinc = huv%gil%vres
  !
  ! Channel range and Weight
  mcol = channels%bounds
  wcol = channels%weight 
  fcol = channels%bounds(1)
  lcol = channels%bounds(2)
  nc = lcol-fcol+1
  !
  ! Compute observing sky frequency for U,V cell size
  if (channels%freq.ne.0) then
    freq = gdf_uv_frequency(huv, channels%freq)
  else
    freq = gdf_uv_frequency(huv)
  endif
  !
  ! Compute gridding function
  ctypx = map%ctype
  ctypy = map%ctype
  call grdflt (ctypx, ctypy, xparm, yparm)
  call convfn (ctypx, xparm, conv%ubuff, conv%ubias)
  call convfn (ctypy, yparm, conv%vbuff, conv%vbias)
  map%uvcell = clight/freq/(map%xycell*map%size)
  map%support(1) = xparm(1)*map%uvcell(1)  ! In meters
  map%support(2) = yparm(1)*map%uvcell(2)
  !
  ! Process sorted UV Table according to the type of beam produced
  !
  allocate (w_w(nv),w_v(nv),w_weight(nv),walls(nb),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Cannot allocate Weight & V arrays')
    error = .true.
    return
  endif
  w_v(:) = uvdata(2,1:nv)
  !
  !
  Print *,'MAP_SUPPoRT ',map%support
  Print *,'MAP_SUPPoRT ',map%uvcell
  Print *,'UVMAX ', uvmax
  lx = (uvmax+map%support(1))/map%uvcell(1) + 2
  ly = (uvmax+map%support(2))/map%uvcell(2) + 2
  lx = 2*lx
  ly = 2*ly
  Print *,'LX LY', lx,ly,nx,ny
  if (ly.gt.ny) then
    write(chain,'(A,A,F8.3)') 'Map cell is too large ',   &
        &      ' Undersampling ratio ',float(ly)/float(ny)
    call map_message(seve%w,rname,chain,3)
    ly = min(ly,ny)
    lx = min(lx,nx)
  endif
  !
  ! Get FFTs and beam work spaces
  allocate (tfgrid(ns+1,lx,ly),& 
    & w_mapu(lx),w_mapv(ly),local_wfft(2*max(nx,ny)),stat=ier) 
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Cannot allocate TF arrays')
    error = .true.
    return
  endif
  !
  call docoor (lx,-map%uvcell(1),w_mapu)
  call docoor (ly,map%uvcell(2),w_mapv)
  !
  if (sic_ctrlc()) then
    abort = .true. ! Quick abort
    return
  endif
  !
  allocate(duv_grid(huv%gil%dim(1),lx*ly),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'UV Grid Memory allocation error')
    error = .true.
    return
  endif
  !
  nthread = 1
  if (nb.gt.1) then
    !$ nthread = ompget_inner_threads()
  endif
  Print *,'MANY_BEAMS_PARA Thread ',nthread,' NB ',nb,' NS ',ns
  !
  ! Loop over blocks
  !
  !$OMP PARALLEL IF (nb.gt.1) DEFAULT(none) NUM_THREADS (nthread) &
  !$OMP PRIVATE(tfgrid,w_weight,w_w) &  ! Big arrays
  !$OMP PRIVATE(w_mapu,w_mapv) &
  !$OMP PRIVATE(local_wfft,chain) &
  !$OMP PRIVATE(local_freq,support,wall,wold,rms,uvcell,local_error) &
  !$OMP PRIVATE(kz,kb,kc,iz,ic, kz1, jc,lc) &
  !$OMP SHARED(walls,ns,nb) PRIVATE(ix,iy,iv) &
  !$OMP SHARED(nu,nv,nx,ny,nc,nd,fcol,lcol,lx,ly, nthread) &
  !$OMP SHARED(map,null_taper,error,abort,grid_code) &
  !$OMP SHARED(conv,freq) &
  !$OMP SHARED(huv,rname) & 
  !$OMP SHARED(w_v,uvdata) SHARED(duv_grid) &
  !$OMP SHARED(cpu0,cpu1) PRIVATE(elapsed_s, elapsed_e, elapsed, ithread)
    ! !$OMP SHARED(w_xgrid,w_ygrid) PRIVATE(w_grid,tfbeam,beam)
    
  kz = 1 ! test for bug below
  !
  ! Print *,'KZ ',kz,' NC ',nc,' nd ',nd
  !$OMP DO
  do ic = fcol,lcol,ns ! ,ns or ,1
    if (sic_ctrlc()) abort = .true. ! Quick abort
    if (abort) cycle
    !
    kz = min(ns,lcol-ic+1)
    jc = min(huv%gil%nchan,ic+ns/3)   ! The default weight channel here...
    !TEST!Print *,'IC ',ic,' JC ',jc,'MCOL ',fcol,lcol,' NS ',ns
    ithread = 1
    !$ elapsed_s = omp_get_wtime()
    !$ ithread = omp_get_thread_num()+1
    !TEST!Print *,'Thread ',ithread,' IC ',ic,', KZ ',kz,', NS ',ns
    !
    kb = (ic-fcol)/ns+1
    if (kb.gt.nb .or. kb.lt.1) then
      Print *,'Programming error, expected 0 < ',kb,' < ',nb+1
      kb = nb
    endif
    !
    w_w(:) = uvdata(7+3*jc,:)
    wold = sump(nv,w_w)
    !
    ! Search for a non empty weight channel
    if (wold.eq.0) then
      do lc=ic,min(ic+ns,lcol) ! not  ,huv%gil%nchan)
        if (lc.ne.jc) then
          w_w(:) = uvdata(7+3*lc,:)
          wold = sump(nv,w_w)
          if (wold.ne.0) then
            jc = lc
            exit
          endif
        endif
      enddo
    endif
    !
    if (wold.eq.0) then
      write(chain,'(A,I6,A)') 'Channel ',jc, ' has zero weight'
      walls(kb) = 0.0
      if (nb.eq.1) then
        call map_message(seve%e,rname,chain)
        error = .true.
      else
        call map_message(seve%w,rname,chain)
      endif
      cycle
    else
      wall = 1e-3/sqrt(wold)
      !TEST!write(chain,'(a,i6,a)') 'Plane ',ic,' Natural '
      !TEST!call prnoise('UV_MAP',trim(chain),wall,rms)
      walls(kb) = wall
    endif
    !
    ! Compute the weights from this
    local_error = .false.
    call doweig (nu,nv,   &
       &    uvdata,   &          ! Visibilities
       &    1,2,    &            ! U, V pointers
       &    jc,     &            ! Weight channel
       &    map%uniform(1),   &  ! Uniform UV cell size
       &    w_weight,   &        ! Weight array
       &    map%uniform(2),   &  ! Fraction of weight
       &    local_error,      &
       &    grid_code)
       
    if (sic_ctrlc()) abort = .true. ! Quick abort
    if (abort) cycle
    if (local_error)  then
      error = .true.
      cycle
    endif
    !
    ! Should also plug the TAPER here, rather than in DOFFT later  !
    call dotape (nu,nv,   &
       &    uvdata,   &          ! Visibilities
       &    1,2,   &             ! U, V pointers
       &    map%taper,  &        ! Taper
       &    w_weight)            ! Weight array
       !TEST!Print *,ic,'dotape'
    if (sic_ctrlc()) abort = .true. ! Quick abort
    if (abort) cycle
    !
    ! Re-normalize the weights and re-count the noise
    wall = sump(nv,w_weight)
    if (wall.ne.wold) then
      call scawei (nv,w_weight,w_w,wall)
      wall = 1e-3/sqrt(wall)
      !TEST!write(chain,'(a,i6,a)') 'Plane ',ic,' Expected '
      !TEST!call prnoise('UV_MAP',trim(chain),wall,rms)
      walls(kb) = wall
    endif
    !
    ! Then compute the Dirty Beam
    local_freq = gdf_uv_frequency(huv, dble(ic))
    uvcell = map%uvcell * (freq / local_freq)
    support = map%support * (freq / local_freq)
    call docoor (lx,-uvcell(1),w_mapu)
    call docoor (ly,uvcell(2),w_mapv)
       !TEST!Print *,ic,'docoor'
    if (sic_ctrlc()) abort = .true. ! Quick abort
    if (abort) cycle
    !
    ! Compute FFTs
    call dofft (nu,nv,          &   ! Size of visibility array
         &    uvdata,           &   ! Visibilities
         &    1,2,              &   ! U, V pointers
         &    ic,               &   ! First channel to map
         &    kz,lx,ly,         &   ! Cube size
         &    tfgrid,           &   ! FFT cube
         &    w_mapu,w_mapv,    &   ! U and V grid coordinates
         &    support,uvcell,null_taper, &  ! Gridding parameters
         &    w_weight,         &   ! Weight array 
         &    conv%ubias,conv%vbias,conv%ubuff,conv%vbuff,map%ctype)
       !TEST!Print *,ic,'dofft'
    if (sic_ctrlc()) abort = .true. ! Quick abort
    if (abort) cycle
    !
    ! Plunge the Gridded TFGRID into a UV Table
    iv = 0
    do iy=1,ly
      do ix=1,lx
        iv = iv+1
        duv_grid(1,iv) = w_mapu(ix)  ! Units to be checked, must be in Meters
        duv_grid(2,iv) = w_mapv(iy)
        duv_grid(3,iv) = 0.0       ! No W term
        duv_grid(4:7,iv) = 0.      ! No valid information here
        do iz=1,kz
          duv_grid(8+(iz-1)*3,iv) = real(tfgrid(iz,ix,iy))
          duv_grid(9+(iz-1)*3,iv) = imag(tfgrid(iz,ix,iy))
          duv_grid(10+(iz-1)*3,iv) = real(tfgrid(kz+1,ix,iy) )! Weight (in some sense)
        enddo
      enddo
    enddo
    !
    if (sic_ctrlc()) abort = .true. ! Quick abort
    if (abort) cycle
    !
    !$  elapsed_e = omp_get_wtime()
    elapsed = elapsed_e - elapsed_s
    write(chain,103) 'End plane ',kc,' Time ',elapsed &
      & ,' Thread ',ithread
    call map_message(seve%d,rname,chain)
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  if (error) return
  if (abort) return
  !
  call gildas_null(hgrid,type='UVT')
  call gdf_copy_header(huv, hgrid, error)
  hgrid%gil%dim(2) = lx*ly
  hgrid%gil%nvisi = lx*ly
  hgrid%file = 'toto.uvt'
  call gdf_write_image(hgrid,duv_grid,error)
  !
  call gag_cpu(cpu1)
  if (jfield.eq.0) then
    write(chain,102) 'Finished maps ',cpu1-cpu0
    call map_message(seve%i,rname,chain)
  endif
  !
  wall = maxval(walls(1:nb))
  if (jfield.eq.0) then
    chain = 'Expected'
  else
    write(chain,'(A,I0,A)') 'Field ',jfield,'; Expected'
  endif
  call prnoise(rname,trim(chain),wall,rms)
  !  !
  ! Delete scratch space
  error = .false.
  if (allocated(tfgrid)) deallocate(tfgrid)
  !
  call imager_tree('UV_GRID_PARA',.true.)
  return
  !
102 format(a,f9.2)
103 format(a,i5,a,f9.2,a,i2,a,i2)
end subroutine uv_grid_para
