subroutine mosaic_uvmap_gueth(task,line,error)
  !$ use omp_lib
  use gkernel_interfaces
  use imager_interfaces, except_this=>mosaic_uvmap_gueth
  use clean_def
  use clean_arrays
  use clean_types
  use clean_default
  use clean_beams 
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- 
  !     Support for command UV_MAP, Mosaic case, Gueth method
  !
  !   Compute a Mosaic from a UV Table with pointing offset information.
  !   "Historical" version using the same Tangent point and Image size
  !   for every field. 
  !
  ! Input quantities :  
  !     a UV table with pointing offset information.
  !   It will be sorted by Field number (and V values, but that no longer matters)
  !
  ! Now, we obtain
  !   HDirty      a 3-d cube containing the uniform noise
  !              combined mosaic, i.e. the sum of the product
  !               of the fields by the primary beam. (NX,NY,NC)
  !   HBeam       a 4-d cube where each cube contains the synthesised
  !               beam for one field (NX,NY,NB,NP)
  !   HPrim       the primary beams pseudo-cube (NP,NX,NY,NB)
  !
  !   lweight     the sum of the square of the primary beams (NX,NY,NB)
  !               only for NB=1 (local Weight array, actually unused)
  !
  ! All images have the same X,Y sizes
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: task   !! Caller (MOSAIC)
  character(len=*), intent(in) :: line   !! Command line
  logical, intent(out) :: error          !! Logical error flag
  !
  ! Constants
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
  character(len=*), parameter :: rname='MOSAIC_GUETH'
  !
  ! Local ---
  type(channel_par) :: channels
  real, allocatable :: w_mapu(:), w_mapv(:), w_grid(:,:)
  real(8) :: newabs(3)
  real(4) :: rmega,uvmax,uvmin,uvma
  integer :: wcol,mcol(2),nfft,sblock,ier
  logical :: one, sorted, shift
  character(len=message_length) :: chain
  real :: cpu0, cpu1
  real(8) :: freq
  real, allocatable :: fft(:)
  real, allocatable :: noises(:)
  integer :: nx,ny,nu,nv,nc,np,mp
  !
  logical :: debug, abort
  type(gildas) :: htmp, pdirty, pbeam
  real :: btrunc, bsize(10), beamsize ! To be initialized
  !
  real, allocatable, target :: dmap(:,:,:), dtmp(:,:,:,:)
  ! real, allocatable, target :: lweight(:,:,:)   !! Only for "old" code
  real, allocatable :: dtrunc(:,:)
  real, allocatable :: doff(:,:)
  integer, allocatable :: teles(:)
  real, pointer :: my_dirty(:,:,:)
  !
  integer, allocatable :: voff(:)
  real :: xm, xp, off_range(2)
  integer :: ifield, jfield, ic, fstart, fend
  integer :: ib, nb, old_ib
  integer, parameter :: o_trunc=1
  integer, parameter :: o_field=2
  type(projection_t) :: proj
  real(8) :: pos(2)
  !
  logical :: per_field
  integer(kind=8) :: ram_map, ram_uv, ram_beam
  integer :: nthread, othread, ithread
  logical :: omp_nested
  logical :: do_jvm
  logical :: do_cct
  real :: jvm_factor
  !
  integer :: ndim, nn(2)
  integer(kind=index_length) :: dim(4)
  complex, allocatable :: comp(:,:)
  !
  ! Code ----
  error = .false.
  call imager_tree('MOSAIC_UVMAP_GUETH',.false.)
  !
  wcol = 0
  debug = .false.
  abort = .false.
  call sic_get_logi('DEBUG',debug,error)
  !
  do_cct = task.eq.'MOSAIC_RESTORE'
  do_jvm = do_cct .and. beam_defined
  !
  ! Get beam size from data or command line
  call sic_get_real('MAP_TRUNCATE',btrunc,error)
  if (error) return
  write(chain,'(A,F4.2,1X,F4.2)') 'Truncation level ',default_map%truncate, btrunc
  call map_message(seve%i,task,chain,3)
  bsize = 0  ! Must be initialized
  if (sic_present(o_trunc,0)) then
    call get_bsize(huv,rname,line,bsize,error,OTRUNC=o_trunc,BTRUNC=btrunc)
  else
    call get_bsize(huv,rname,line,bsize,error,BTRUNC=btrunc)
  endif
  if (error) return
  beamsize = maxval(bsize)
  write(chain,'(a,(f10.2),a,f6.0,a)') 'Correcting for a beam size of ',&
    & beamsize/pi*180*3600,'" down to ',100*btrunc,'% '
  call map_message(seve%i,rname,chain)
  !
  call map_prepare(task,huv,themap,error)
  if (error) return
  !
  one = .true.  
  call uvmap_cols(rname,line,huv,channels,error)
  if (error) return 
  mcol = channels%bounds
  wcol = channels%weight
  !
  ! Select Fields first
  mp = abs(themap%nfields)
  if (.not.do_cct) then
    call sic_delvariable('FIELDS%N_SELECT',.false.,error)
    call sic_delvariable('FIELDS%SELECTED',.false.,error)
    error = .false.
    !
    ! Get the field lists from the /FIELDS option if any
    if (allocated(selected_fields)) deallocate(selected_fields)
    selected_fieldsize = 0
    if (sic_present(o_field,0)) then
      call select_fields(rname,line,o_field,mp,np,selected_fields,error)
      if (error) return
      selected_fieldsize = np
      call sic_def_inte('FIELDS%N_SELECT',selected_fieldsize,0,0,.true.,error)
      dim(1) = selected_fieldsize
      call sic_def_inte('FIELDS%SELECTED',selected_fields,1,dim,.true.,error) 
    endif
  else if (selected_fieldsize.ne.0) then
    np = selected_fieldsize
    write(chain,'(A,I0,A,20(1X,I0))') 'Restoring only ',selected_fieldsize, &
    & ' Fields: ',selected_fields(1:min(20,selected_fieldsize))
    call map_message(seve%i,rname,chain,3)
  else 
    np = mp
  endif
  !
  if (selected_fieldsize.eq.0)  then
    np = mp
    if (allocated(selected_fields)) deallocate(selected_fields)
    allocate(selected_fields(mp),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation on Selected Fields')
    endif
    do jfield=1,np
      selected_fields(jfield) = jfield
    enddo
  endif
  !
  call gag_cpu(cpu0)
  !
  ! Shifting to Phase center Offsets has been done by calling UV_SHIFT_MOSAIC before
  newabs = [huv%gil%a0,huv%gil%d0,huv%gil%pang]
  shift = .false. 
  !
  ! Note: the sorting should have FIELD ID as primary (slowest varying) key
  !
  if (allocated(teles)) deallocate(teles)
  if (allocated(doff)) deallocate(doff)
  if (allocated(voff)) deallocate(voff)
  allocate(doff(2,mp),voff(mp+1),teles(mp),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  !
  call mosaic_sort (error,sorted,shift,newabs,uvmax,uvmin, &
    & huv%gil%column_pointer(code_uvt_xoff), &
    & huv%gil%column_pointer(code_uvt_yoff), &
    & huv%gil%column_pointer(code_uvt_id), &
    & mp,doff,voff)
  if (sic_ctrlc()) then
    call map_message(seve%e,rname,'Aborted by user')
    error = .true.
  endif
  if (error) return 
  !
  teles(1:mp) = huv%mos%fields(:)%jteles 
  !
  xm = minval(doff(1,1:mp))
  xp = maxval(doff(1,1:mp))
  off_range(1) = xp-xm
  xm = minval(doff(2,1:mp))
  xp = maxval(doff(2,1:mp))
  off_range(2) = xp-xm
  !
  if (.not.sorted) then
    Print *,'Done mosaic_sort UV range ',uvmin,uvmax,' sorted ',sorted
    call uv_dump_buffers('UV_MOSAIC')
    ! Redefine SIC variables (mandatory)
    ! Caution: this overrides command line pointers
    call map_uvgildas ('UV',huv,error,duv) 
  else
    Print *,'Mosaic was sorted ',uvmin,uvmax,' sorted ',sorted
  endif
    call uv_dump_buffers('UV_MOSAIC - SORT')
  !
  call gag_cpu(cpu1)
  write(chain,'(A,F9.2)') 'Finished sorting ',cpu1-cpu0
  call map_message(seve%i,task,chain)
  !
  ! Get map parameters
  call map_parameters(task,themap,huv,freq,uvmax,uvmin,error)
  if (error) return
  uvma = uvmax/(freq*f_to_k)
  !
  themap%xycell = themap%xycell*pi/180.0/3600.0
  !
  ! Get work space, before mapping first image, for memory contiguity reasons.
  !
  nx = themap%size(1)
  ny = themap%size(2)
  nu = huv%gil%dim(1)  
  nv = huv%gil%nvisi     ! not huv%gil%dim(2)
  nc = mcol(2)-mcol(1)+1 ! not huv%gil%nchan
  !
  allocate(w_mapu(nx),w_mapv(ny),w_grid(nx,ny),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,task,'Gridding allocation error')
    goto 98
  endif
  !
  do_weig = .true.
  if (do_weig) then
    call map_message(seve%i,task,'Computing weights (Mosaic)')
    if (allocated(g_weight)) deallocate(g_weight)
    if (allocated(g_v)) deallocate(g_v)
    allocate(g_weight(nv),g_v(nv),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,task,'Weight allocation error')
      goto 98
    endif
  else
    call map_message(seve%i,task,'Re-using weights')
  endif
  nfft = 2*max(nx,ny)
  allocate(fft(nfft),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,task,'FFT allocation error')
    goto 98
  endif
  !
  rmega = 8.0
  ier = sic_ramlog('SPACE_IMAGER',rmega)
  sblock = max(int(256.0*rmega*1024.0)/(nx*ny),1)
  !
  ! New Beam place
  if (allocated(dbeam)) then
    call sic_delvariable ('BEAM',.false.,error)
    deallocate(dbeam)
  endif
  call gildas_null(hbeam)
  !
  ! New dirty image
  allocate(dmap(nx,ny,nc),dtrunc(nx,ny),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,task,'Map allocation error')
    goto 98
  endif
  !
  if (.not.do_cct) then
    if (allocated(ddirty)) then
      call sic_delvariable ('DIRTY',.false.,error)
      deallocate(ddirty)
    endif
    allocate(ddirty(nx,ny,nc),stat=ier)
    my_dirty => ddirty
  else
    if (allocated(dresid)) then
      call sic_delvariable ('RESIDUAL',.false.,error)
      deallocate(dresid)
    endif
    allocate(dresid(nx,ny,nc),stat=ier)
    my_dirty => dresid
  endif
  if (ier.ne.0) then
    call map_message(seve%e,task,'Map allocation error')
    goto 98
  endif
  !
  call gildas_null(hdirty)
  hdirty%gil%ndim = 3
  hdirty%gil%dim(1:3) = (/nx,ny,nc/)
  !
  ! Compute the primary beams and weight image
  call gildas_null(hprim)
  if (allocated(dprim)) then
    call sic_delvariable ('PRIMARY',.false.,error)
    deallocate(dprim)
  endif
  if (allocated(dfields)) then
    deallocate(dfields)
  endif
  !
  ! !Print *,'Done MAP_BEAMS ',themap%beam,nb
  !
  ! Find out how many beams are required
  call define_beams(rname,themap%beam,nx,ny,huv,mcol,nb,error)
  if (error) return
  ! Define the map characteristics
  call mosaic_headers (rname,themap,huv,hbeam,hdirty,hprim,nb,np,mcol)
  !
  write(chain,'(A,I0,A,I0,A)') 'Imaging channel range [',mcol(1),',',mcol(2),']'
  call map_message(seve%i,task,chain)
  !
  ! Check if Weights have changed by MCOL choice
  if (any(saved_chan%bounds.ne.mcol)) do_weig = .true. ! Useless ???? NEW
  saved_chan%bounds = mcol
  !
  ! Define the projection about the Phase center
  call gwcs_projec(huv%gil%a0,huv%gil%d0,huv%gil%pang,huv%gil%ptyp,proj,error)
  !
  ! POS is here the Offset of the Pointing center relative to the Phase center
  ! (This may be Zero in most cases) 
  call abs_to_rel (proj,huv%gil%ra,huv%gil%dec,pos(1),pos(2),1)
  !
  ! Code ready and now tested for several channels per Beam
  hbeam%gil%ndim = 4
  hbeam%gil%dim(1:4)=(/nx,ny,nb,np/)
  !
  !
  allocate (dtmp(nx,ny,nb,1), dbeam(nx,ny,np,nb), dprim(np,nx,ny,nb), stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,task,'NB>1 Primary beam allocation error')
    goto 98
  endif
  !
  hprim%r4d => dprim
  call primary_mosaic(line,np,hprim,hdirty,selected_fields,& 
	& selected_fieldsize,doff,pos,teles,bsize,error)
  if (error) return
  call map_message(seve%i,rname,'Done Primary Beams')
  !
  ! Loop on fields for imaging
  ! Use Dtmp and Dmap as work arrays for beam and image
  hbeam%r3d => dtmp(:,:,:,1)
  hbeam%gil%dim(4) = 1
  !
  ! IN Parallel part, DMAP will be copied per Thread
  ! So we have to verify that the Parallel mode actually fits into Memory
  !
  othread = 1  
  !$ othread = omp_get_max_threads()
  !
  ! Verify memory requirements
  ram_uv = huv%gil%dim(1)*huv%gil%dim(2)/512/512
  ram_map = 2*hdirty%gil%dim(1)*hdirty%gil%dim(2)*hdirty%gil%dim(3)/512/512
  ram_beam = 2*hbeam%gil%dim(1)*hbeam%gil%dim(2)*hbeam%gil%dim(3)*hbeam%gil%dim(4)/512/512
!    Print *,'   RAM Map ',ram_map,hdirty%gil%dim(1:4)    Print *,'   RAM Beam ',ram_beam,hbeam%gil%dim(1:4)
  ram_map = ram_map+ram_beam
  !
  nthread = min(othread,np)
  if (ram_map*nthread.gt.sys_ramsize) nthread = nint(real(sys_ramsize)/real(ram_map))
  nthread = max(nthread,1) ! Just in case
  !
  ram_map = ram_map * min(nthread, np)
  if (ram_map.gt.0.2*sys_ramsize) then
    write(chain,'(A,F8.1,A,F8.1,A,F8.1,A)') 'Data size (UV ',1d-3*ram_uv,& 
      & 'GB + Map ',1D-3*ram_map, &
      & 'GB), available RAM (',1d-3*sys_ramsize,' GB)'
    call map_message(seve%w,rname,chain,3)
    if (ram_map.gt.sys_ramsize) then
      call map_message(seve%e,'Data size exceeds RAM',chain,3)
      error = .true.
      return
    endif
  endif
  !
  !$ call ompset_thread_nesting(rname, nthread, othread, omp_nested)    
  !$ nthread = ompget_outer_threads()
  if (nthread.gt.1) then
    per_field = .true.    
    write(chain,'(A,I0,A,I0,A)') 'Using per-field parallel mode. - Threads ',nthread,' Fields ',np
    call map_message(seve%i,rname,chain,3)
  endif
  !
  hdirty%r3d => dmap
  !
  my_dirty = 0
  dbeam = 0
  allocate(noises(np))  ! To remember the noise
  abort = .false.
  if (sic_ctrlc()) then
    error = .true.
    call map_message(seve%e,rname,'Aborted by user')
    return
  endif
  !
  if (per_field) then
    write(chain,'(A,I0,A,I0,A)') 'Starting per-field parallel loop on channel range [', &
      & mcol(1),'-',mcol(2),']'
    call map_message(seve%i,rname,chain)
  else
    call map_message(seve%i,rname,'Using per-Plane parallelism')
  endif
  !
  ! FFTW plan
  ndim = 2
  nn(1) = hdirty%gil%dim(1)
  nn(2) = hdirty%gil%dim(2)
  allocate(comp(nx,ny),stat=ier)
  call fourt_plan(comp,nn,ndim,-1,1)
  !
  !
  !$OMP PARALLEL DEFAULT(none) if (per_field) NUM_THREADS (nthread) &
  !$OMP   & SHARED(np,debug,task,themap,huv,dprim,dbeam,my_dirty) & 
  !$OMP   & PRIVATE(pdirty,pbeam) &
  !$OMP   & SHARED(hdirty,hbeam) &
  !$OMP   & SHARED(voff, selected_fields, noises, nthread) &
  !$OMP   & SHARED(nx,ny,nu,nc,duv,channels,sblock,cpu0,uvma,btrunc,abort) &
  !$OMP   & SHARED(g_weight) PRIVATE(ifield,jfield) &
  !$OMP   & PRIVATE(fstart,fend,nv,do_weig,error,chain) &
  !$OMP   & PRIVATE(old_ib,ic,ib,dtrunc,dmap,dtmp, ithread) &
  !$OMP   & SHARED(beams_param,do_jvm,do_cct) PRIVATE(jvm_factor)
  ithread = 1
  !$ ithread = omp_get_thread_num()+1
  call gildas_null(pdirty)
  call gildas_null(pbeam)
  call gdf_copy_header(hdirty,pdirty,error)
  call gdf_copy_header(hbeam,pbeam,error)
  !$OMP DO
  do jfield = 1,np
    if (sic_ctrlc()) then
      abort = .true.
    endif
    if (abort) cycle ! Quick jump if Abort (EXIT not allowed in Parallel mode)
    !
    ifield = selected_fields(jfield)
    ! Pour le mode parallele
    pdirty%r3d => dmap
    pbeam%r3d => dtmp(:,:,:,1)
    !
    do_weig = .true.
    if (do_cct) then             ! Visibilities have been extracted
      fstart = voff(jfield)      ! Starting Visibility of field
      fend   = voff(jfield+1)-1  ! Ending Visibility of field
    else
      fstart = voff(ifield)      ! Starting Visibility of field
      fend   = voff(ifield+1)-1  ! Ending Visibility of field
    endif
    nv = fend-fstart+1
    if (debug) then
      Print *,'Ifield ',ifield,fstart,fend
      Print *,'Cols ',channels%freq,channels%bounds,channels%weight
      Print *,'Sizes ',nx,ny,nu,nv,np,nc
      Print *,'Calling many_beams_para with SBLOCK ',sblock
    endif
    write(chain,'(A,I0,A,I0)') 'Field ',ifield,' Visi ',nv
    call map_message(seve%d,task,chain)
    ! We could write the Thread or Field number in "task" argument...
    call many_beams_para (task,themap, channels, huv, pbeam, pdirty,   &
       &    nx,ny,nu,nv,duv(:,fstart:fend),   &
       &    g_weight(fstart:fend), do_weig,  &
       &    sblock,cpu0,error,uvma,ifield,abort,ithread)
    !
    noises(jfield) = pdirty%gil%noise   ! Remember the noise
    if (abort) cycle                    ! Cannot Return
    !
    old_ib = 0
    !
    do ic=1,nc
      ib = beam_for_channel(ic,pdirty,pbeam)
      if (do_jvm) then
        jvm_factor = beams_param(4,ib,jfield)
        if (jvm_factor.eq.0.) jvm_factor = 1.
        write(chain,'(A,I0,A,I0,A,F7.3,A,I0)')  &
          & 'Field ',jfield,', Beam ',ib,', JvM factor ',jvm_factor,'; Thread ',ithread
        call map_message(seve%i,task,chain)
      else
        jvm_factor = 1.
      endif
      if (debug) Print *,'Selected beam ',ib, jvm_factor
      ! Add it to the "mosaic dirty" image, by multiplying by
      ! the truncated primary beam
      if (ib.ne.old_ib) then
        dtrunc(:,:) = dprim(jfield,:,:,ib)
        if (debug) Print *,'Set DTRUNC ',ib,' # ',old_ib
        where (dtrunc.lt.btrunc) dtrunc = 0
        old_ib = ib
      endif
      !$OMP CRITICAL
      ! We use here the JvM factor for the Residual image 
      my_dirty(:,:,ic) = my_dirty(:,:,ic) + dmap(:,:,ic)*dtrunc(:,:)*jvm_factor
      !$OMP END CRITICAL
    enddo
    !
    ! Save the beam - Transposition could be done here if needed
    !! dbeam(:,:,:,jfield) = dtmp(:,:,:,1)
    dbeam(:,:,jfield,:) = dtmp(:,:,:,1) ! Transpose      
    if (.not.do_jvm) then
      write(chain,'(A,I0,A,I0)') 'Ending Field ',ifield,' Thread ',ithread
      call map_message(seve%i,task,chain)
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  if (per_field) then
    !$  call omp_set_nested(omp_nested)
    !$  call omp_set_num_threads(othread)
  endif
  if (abort) then
    call map_message(seve%w,task,'Aborted by user')
    error = .true.
    return
  endif
  hdirty%gil%noise = sum(noises)/np
  !
  ! Set the BEAM header 
  call gildas_null(htmp)
  call gdf_copy_header(hbeam,htmp,error)
  htmp%gil%ndim = 4
  call gdf_transpose_header(htmp,hbeam,'1243',error)
  if (error) return
  hbeam%r4d => dbeam  
  hbeam%gil%dim(1:4)=(/nx,ny,np,nb/)
  hbeam%gil%ndim = 4
  !! if (nb.eq.1) hbeam%gil%ndim = 3
  call sic_mapgildas('BEAM',hbeam,error,dbeam)
  !
  ! OK we are done (apart from details like Extrema)
  !
  hprim%gil%inc(1) = btrunc  ! Convention to store the truncation level
  call sic_mapgildas('PRIMARY',hprim,error,dprim)
  !
  ! Reset the Dirty pointer
  hdirty%r3d => my_dirty
  hdirty%loca%addr = locwrd(my_dirty)
  !
  ! Nullify Filtered channels and Compute Dirty extrema 
  call cube_flag_extrema(huv%gil%nchan,'DIRTY',mcol,hdirty)
  !
  ! Correct the noise for the approximate gain at mosaic center
  ! for HWHM hexagonal spacing (normally it is sqrt(1+6/4)) 
  hdirty%gil%noise = hdirty%gil%noise/sqrt(2.5)
  if (.not.do_cct) then 
    call sic_mapgildas('DIRTY',hdirty,error,ddirty)
    !
    save_data(code_save_beam) = .true.
    save_data(code_save_dirty) = .true.
    save_data(code_save_primary) = .true.
    save_data(code_save_fields) = .true.
    !
    call new_dirty_beam
    !
    ! Define Min Max
    call cube_minmax('DIRTY',hdirty,error)
    !
    d_max = hdirty%gil%rmax
    if (hdirty%gil%rmin.eq.0) then
      d_min = -0.03*hdirty%gil%rmax
    else
      d_min = hdirty%gil%rmin
    endif
  else
    ! Restore the DIRTY image pointer
    hdirty%r3d => ddirty
    call cube_minmax('DIRTY',hdirty,error)
    ! And define the RESIDUAL
    call gdf_copy_header(hdirty,hresid,error)
    hresid%r3d => dresid
    call cube_minmax('RESIDUAL',hresid,error)
    call sic_mapgildas('RESIDUAL',hresid,error,dresid)
  endif
  !
  error = .false.
  !
  ! Backward compatibility with previous methods
  user_method%trunca = btrunc     ! By convention
  hprim%gil%convert(3,4) = beamsize  ! Primary beam size convention
  call sub_mosaic('ON',error)
  !
  if (allocated(w_mapu)) deallocate(w_mapu)
  if (allocated(w_mapv)) deallocate(w_mapv)
  if (allocated(w_grid)) deallocate(w_grid)
  if (allocated(fft)) deallocate(fft)
  call imager_tree('MOSAIC_UVMAP_GUETH',.false.)
  return
  !
98 call map_message(seve%e,task,'Memory allocation failure')
  error = .true.
  return
end subroutine mosaic_uvmap_gueth
!
