subroutine beam_jvm(hbeam,dbeam,jvm,circle,print,error)
  use image_def
  use gkernel_interfaces
  !-------------------------------------------------------------
  !   @ private
  !
  !*
  !   IMAGER -- Support for FIT /JVM command 
  !   Evaluate the Jorsater - van Moorsel residual scaling factor.
  !   from the dirty beam shape.
  !!
  !-------------------------------------------------------------
  type(gildas), intent(in) :: hbeam       !! Beam header
  real, intent(in) :: dbeam(:,:)          !! 2-D beam
  real, intent(out) :: jvm                !! Scaling factor
  logical, intent(in) :: circle           !! Method of circular averaging
  logical, intent(in) :: print            !! Save results for display
  logical, intent(out) :: error           !! Logical Error flag
  !
  ! Local ---
  integer :: npix, nx, ny, ix, iy, ir, ier, io
  real(8) :: cospa, sinpa, ux, uy, vx, vy, zz, ctot, dtot
  real(8) :: radius, major, minor, angle, zero, epsilon
  real(8), allocatable :: axis(:), dc(:), dd(:), cc(:), cd(:), area(:)
  integer, allocatable :: count(:)
  !
  ! Code ----
  error = .false.
  nx = hbeam%gil%dim(1)
  ny = hbeam%gil%dim(2)
  npix = min(nx,ny)/2
  !
  allocate (axis(npix), dd(npix), dc(npix), cc(npix), cd(npix), count(npix), area(npix), stat=ier)
  if (ier.ne.0) then
    error = .true.
    return
  endif
  !
  ! Compute Clean beam
  major = hbeam%gil%majo
  minor = hbeam%gil%mino
  angle = hbeam%gil%posa
  cospa = cos(angle) 
  sinpa = sin(angle)
  !
  count = 0
  dc = 0
  dd = 0
  axis = 0
  !
  ! Compute the azimutal averages of the Clean and Dirty beams,
  ! after circularization of the Clean beam, or not (according to "circle" 
  do iy=1,ny
    uy = (iy-hbeam%gil%convert(1,2))*hbeam%gil%convert(3,2)
    do ix=1,nx
      ux = (ix-hbeam%gil%convert(1,1))*hbeam%gil%convert(3,1)
      !
      vx = cospa * ux - sinpa * uy
      vy = sinpa * ux + cospa * uy
      !
      ! zz is the Square of the "deprojected" distance in Clean beam axis size
      ! so we might directly use that for the distance instead of the coordinate
      !
      zz = (vx/major)**2 + (vy/minor)**2
      zz = zz * 4.d0*log(2d0) ! FWHM to sigma conversion
      !
      if (circle) then
        radius = sqrt(zz)*major     ! Circularized beam
      else
        !
        radius = sqrt(ux**2+uy**2)  ! Elliptical beam
      endif
      ir = nint(radius/abs(hbeam%gil%convert(3,1)))
      if (ir.gt.0 .and. ir.le.npix) then
        count(ir) = count(ir)+1
        dc(ir) = dc(ir) + exp(-zz)
        dd(ir) = dd(ir) + dbeam(ix,iy) 
        axis(ir) = axis(ir) + radius
      endif
    enddo
  enddo
  !
  io = 0
  do ir=1,npix
    if (count(ir).ne.0) then
      io = io+1
      axis(io) = axis(ir)/count(ir)
      dc(io) = dc(ir)/count(ir)
      dd(io) = dd(ir)/count(ir)
      area(io) = count(ir)
    endif
  enddo
  !
  npix = io
  call gr8_trie(axis,count,npix,error)
  call gr8_sort(dc,cc,count,npix)
  call gr8_sort(dd,cc,count,npix)
  call gr8_sort(area,cc,count,npix)
  !
  ! Compute cumulative areas as a function of radius.
  ! Identify first null of the Dirty beam.
  ! Derive JvM factor as ratio of Clean to Dirty beam areas at first null.
  ctot = 0
  dtot = 0
  zero = 0
  epsilon = 0
  do ir=1,npix
    cc(ir) = ctot
    cd(ir) = dtot
    ctot = ctot + dc(ir)*area(ir)
    dtot = dtot + dd(ir)*area(ir)
    !!Print *,'IR ',ir,' Zero ',zero,' DD ',dd(ir),' Epsilon ',epsilon
    if ((zero.eq.0).and.(dd(ir).lt.zero)) then
      zero = axis(min(npix,ir+5))
      epsilon = cc(ir-1)/cd(ir-1) 
    endif
  enddo
  jvm = epsilon
  if (.not.print) return
  !
  ! This part is not Thread-Safe, but never called if in a parallel mode.
  !
  ! This is to debug the behaviour. It is based on the value of the 
  ! JVM_PRINT SIC variable decoded in the "clean_beam" routine.
  write(1,*) zero, epsilon
  write(1,*) axis(1),dc(1),dd(1),cc(1),cd(1),1.0d0,area(ir)
  do ir=2,npix
    write(1,*) axis(ir),dc(ir),dd(ir),cc(ir),cd(ir),cc(ir)/cd(ir),area(ir)
  enddo
  close(unit=1)
  !
end subroutine beam_jvm
!
subroutine fit_comm (line,error)
  use gkernel_interfaces
  use clean_def
  use clean_default
  use clean_arrays
  use clean_beams
  use gbl_message
  use imager_interfaces, only : map_message, sub_fit_beam
  !-------------------------------------------------------------
  !   @ private
  !*
  ! IMAGER -- Code for COMMAND  
  !   FIT [First Last] [PLANE|CHANNEL|FIELD First Last]   
  !       [PLANE|CHANNEL|FIELD First Last] [/JVM_FACTOR  [NoCircle]]  
  !       [/THRESHOLD Value]
  !!
  !-------------------------------------------------------------
  character(len=*), intent(in) :: line  !! Command line
  logical, intent(inout) :: error       !! Logical error flag
  !
  ! Constants
  character(len=*), parameter :: rname = 'FIT'
  real(kind=8), parameter :: pi=acos(-1d0)
  real, parameter :: sec_to_rad=acos(-1.0)/180./3600.
  real, parameter :: rad_to_sec=180.*3600./acos(-1.0)
  integer, parameter :: o_thresh=2
  integer, parameter :: o_jvm=1
  integer, parameter :: mtype=3
  character(len=8) :: ctype(mtype)
  data ctype /'CHANNEL','PLANE','FIELD'/
  !
  ! Local ---
  integer :: nfield, cfirst, clast, ffirst, flast, nchan, iarg, itype, narg, k
  logical :: do_jvm, do_circle, jvm_print
  character(len=8) :: argum, ktype
  !
  ! Code ----
  error =.true.
  !
  if (hbeam%loca%size.eq.0) then
    call map_message(seve%e,rname,'No Dirty Beam')
    return
  endif
  error = .false.
  !
  nchan = hbeam%gil%dim(hbeam%gil%faxi)
  !
  nfield = 1
  if (hbeam%char%code(3).eq.'FIELD') then
    nfield = hbeam%gil%dim(3)
  endif
  if (hbeam%gil%ndim.gt.3) then
    if (hbeam%char%code(4).eq.'FIELD') then
      nfield = hbeam%gil%dim(4)
    endif
  endif
  !
  ffirst = 1
  flast = 0
  cfirst = 1
  clast = 0
  narg = sic_narg(0)
  !
  if ((nfield.gt.1).and.(nchan.gt.1)) then
    !
    ! Required Keyword FIELD or PLANE or CHANNEL
    iarg = 1
    do while (iarg.le.narg)
      argum = ' '
      call sic_ke(line,0,1,argum,k,.true.,error)
      if (error) return
      call sic_ambigs('FIT',argum,ktype,itype,ctype,mtype,error)
      if (error) return
      iarg = iarg+1
      !
      if (itype.eq.3) then ! FIELD
        ffirst = 1
        call sic_i4 (line,0,iarg,ffirst,.false.,error)
        if (iarg.eq.narg) then
          flast = ffirst
        else
          iarg = iarg+1
          flast = 0
          call sic_i4 (line,0,iarg,flast,.false.,error)
          if (error) return
        endif
      else
        cfirst = 1
        call sic_i4 (line,0,iarg,cfirst,.false.,error)
        if (iarg.eq.narg) then
          clast = cfirst
        else
          iarg = iarg+1
          clast = 0
          call sic_i4 (line,0,iarg,clast,.false.,error)
          if (error) return
        endif
        if (error) return
      endif
      iarg = iarg+1
    enddo
    !
  else if (narg.gt.0) then     
    ! Here, keywords are optional
    argum = ' '
    call sic_ke(line,0,1,argum,k,.false.,error)
    if (nchan.gt.1) then
      !  only CHANNEL or PLANE is allowed
      if ((argum(1:1).ne.'P').and.(argum(1:1).ne.'C')) then
        iarg = 1
      else
        call sic_ambigs(' ',argum,ktype,itype,ctype,2,error)
        if (.not.error) iarg = 2
        error = .false.
      endif
      cfirst = 1
      call sic_i4 (line,0,iarg,cfirst,.false.,error)
      iarg = iarg+1
      clast = 0
      call sic_i4 (line,0,iarg,clast,.false.,error)
      if (error) return
    else
      ! only FIELD is allowed
      if (argum(1:1).ne.'F') then
        iarg = 1
      else
        call sic_ambigs(' ',argum,ktype,itype,ctype(3),1,error)
        if (.not.error) iarg = 2
        error = .false.
      endif
      ffirst = 1
      call sic_i4 (line,0,iarg,ffirst,.false.,error)
      iarg = iarg+1
      flast = 0
      call sic_i4 (line,0,iarg,flast,.false.,error)
      if (error) return
    endif    
    !
  endif
  if (flast.le.0) flast = nfield+flast
  if (clast.le.0) clast = nchan+clast
  !
  cfirst = min(max(1,cfirst),nchan)
  clast = max(cfirst,min(clast,nchan))
  ffirst = min(max(1,ffirst),nfield)
  flast = max(ffirst,min(flast,nfield))
  !
  the_method%thresh = user_method%thresh
  call sic_r4(line,o_thresh,1,the_method%thresh,.false.,error)
  if (error) return
  !
  do_jvm = sic_present(o_jvm,0)
  if (do_jvm) then
    do_circle = .not.sic_present(o_jvm,1)
    jvm_print = .false.
    call sic_get_logi('JVM_PRINT',jvm_print,error)
    error = .false.
  endif
  !--- End of parsing section
  call sub_fit_beam(nfield,nchan,ffirst,flast,cfirst,clast, &
    & do_jvm, do_circle, jvm_print, error)
end subroutine fit_comm
!
subroutine sub_fit_beam(nfield,nchan,ffirst,flast,cfirst,clast, &
    & do_jvm, do_circle, jvm_print, error)
  use gkernel_interfaces
  use clean_def
  use clean_default
  use clean_arrays
  use clean_beams
  use gbl_message
  use imager_interfaces, only : map_message, get_clean, beam_jvm
  !-------------------------------------------------------------
  !   @ private
  !*
  ! IMAGER -- BEAM Utility  
  !     Fit the dirty beam to get the beam sizes
  !!
  !-------------------------------------------------------------
  integer, intent(in) :: nfield     !! Number of fields 
  integer, intent(in) :: nchan      !! Number of channels
  integer, intent(in) :: ffirst     !! first field
  integer, intent(in) :: cfirst     !! first channel
  integer, intent(in) :: flast      !! last field
  integer, intent(in) :: clast      !! last channel
  logical, intent(in) :: do_jvm     !! Use JVM factor
  logical, intent(in) :: do_circle  !! circularize for JVM
  logical, intent(in) :: jvm_print  !! Print JVM factors
  logical, intent(inout) :: error   !! Error flag
  !
  ! Global
  character(len=*), parameter :: rname='FIT'
  real(kind=8), parameter :: pi=acos(-1d0)
  real, parameter :: sec_to_rad=acos(-1.0)/180./3600.
  real, parameter :: rad_to_sec=180.*3600./acos(-1.0)
  !
  ! Local
  type(gildas) :: head
  character(len=12) :: name
  character(len=132) :: chain
  integer(kind=index_length) :: dim(3)
  real :: jvm
  integer :: ier, kgood, kempty, jplane, jfield, iw,iz
  !
  ! Define the BEAM_VALUES variable
  if ((nchan.ne.beams_number).or.(nfield.ne.beams_field)) then
    beam_defined = .False.
    if (beams_number.ne.0) then
      call sic_delvariable('BEAM_VALUES',.false.,error)
      error = .false.
      deallocate(beams_param)
      beams_number  = 0
      beams_field = 1
    endif
    allocate(beams_param(4,nchan,nfield),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'BEAM_VALUES allocation error')
      error = .true.
      return
    endif
    beams_param = 0.
    beams_field = nfield
    beams_number = nchan
    dim = [4,beams_number,beams_field]
    call sic_def_real('BEAM_VALUES',beams_param,3,dim,.true.,error)
  endif
  !
  if (do_jvm) then
    call gildas_null(head)
    call gdf_copy_header(hbeam,head,error)
  endif
  !
  ! Ok, now compute 
  beam_fitted = 0.
  jvm = 0 ! Required...
  kgood = 0
  kempty = 0
  !
  name = the_method%method
  the_method%method = '  '
  do jfield = ffirst, flast
    do jplane = cfirst, clast
      the_method%major = 0.0
      the_method%minor = 0.0
      the_method%angle = 0.0
      !
      call beam_unit_conversion(the_method)
      !
      if (hbeam%gil%faxi.eq.3) then
        iz = jplane
        iw = jfield
      else
        iz = jfield
        iw = jplane
      endif
      error = .false.
      call get_clean (the_method, hbeam, dbeam(:,:,iz,iw),error)
      if (error) then
        kempty = kempty+1
        cycle  ! Avoid empty beams
      endif
      if (do_jvm) then 
        head%gil%majo = the_method%major
        head%gil%mino = the_method%minor
        head%gil%posa = the_method%angle*pi/180
        call beam_jvm(head,dbeam(:,:,iz,iw),jvm,do_circle,jvm_print,error)
        error = .false.
        beam_fitted(4) = beam_fitted(4) + jvm
      endif
      call pribeam('FIT',the_method%major,the_method%minor,the_method%angle,jfield,jplane,jvm)
      !
      ! Put in output variables
      beams_param(:,jplane,jfield) = [the_method%major,the_method%minor,the_method%angle,jvm]
      !
      beam_fitted(1) = beam_fitted(1) + the_method%major*rad_to_sec
      beam_fitted(2) = beam_fitted(2) + the_method%minor*rad_to_sec
      beam_fitted(3) = beam_fitted(3) + the_method%angle
      kgood = kgood+1
    enddo
  enddo
  the_method%method = name
  beam_fitted = beam_fitted/kgood
  if (beam_fitted(4).eq.0) beam_fitted(4) = 1.0
  !
  ! Put in Beam Header
  hbeam%gil%reso_words = 3
  hbeam%gil%majo = beam_fitted(1)*sec_to_rad 
  hbeam%gil%mino = beam_fitted(2)*sec_to_rad
  hbeam%gil%posa = beam_fitted(3) * pi /180
  !
  if (.not.beam_defined) then
    call sic_def_real('BEAM_FITTED',beam_fitted,1,3,.true.,error)
    call sic_def_real('BEAM_JVM',beam_fitted(4),0,0,.true.,error)
    call sic_def_inte('BEAM_NUMBER',beams_number,0,0,.true.,error)
    call sic_def_inte('BEAM_FIELD',beams_field,0,0,.true.,error)
    beam_defined = .true.
  endif
  !
  if (kempty.ne.0) then
    write(chain,'(A,I0,A)') 'Found ',kempty,' empty beams' 
    call map_message(seve%w,rname,chain)
  endif
  if (kgood.gt.1) then
    write(chain,'(A,I0,A)') 'Averaged ',kgood,' beams'
    call map_message(seve%i,rname,chain)
    if (beam_fitted(4).eq.1.0) then
      write(chain,120) 'Beam is ',beam_fitted(1), beam_fitted(2),beam_fitted(3) 
    else
      write(chain,110) 'Beam is ',beam_fitted(1), beam_fitted(2),beam_fitted(3), beam_fitted(4) 
    endif
    call map_message(seve%i,rname,chain)
  endif
  !
  110   format (a,f8.3,'" by ',f8.3,'" at PA ',f5.1,' deg., JvM factor ',f6.3)
  120   format (a,f8.3,'" by ',f8.3,'" at PA ',f5.1,' deg. ') ! ' Field ',I3,', Channel ',I5,A,F5.2)
end subroutine sub_fit_beam
!
subroutine new_dirty_beam
  use gkernel_interfaces
  use clean_def
  use clean_arrays
  use clean_beams
  !
  !! IMAGER -- BEAM Utility  
  !! Called when a new dirty map is computed by command UV_MAP
  !
  logical :: error
  !
  ! Code ----
  error = .false.
  if (beam_defined) then
    call sic_delvariable('BEAM_VALUES',.false.,error)
    call sic_delvariable('BEAM_FITTED',.false.,error)
    call sic_delvariable('BEAM_JVM',.false.,error)
    call sic_delvariable('BEAM_NUMBER',.false.,error)
    call sic_delvariable('BEAM_FIELD',.false.,error)
    error = .false.
    deallocate(beams_param)
    beams_number  = 0
    beams_field = 1
    beam_defined = .false.
  endif
  !
  if (allocated(dclean)) deallocate(dclean)
  call sic_delvariable ('CLEAN',.false.,error)
  hclean%loca%size = 0
  !
  if (allocated(dresid)) deallocate(dresid)
  call sic_delvariable ('RESIDUAL',.false.,error)
  hresid%loca%size = 0
  !
  if (allocated(dcct)) deallocate(dcct)
  call sic_delvariable ('CCT',.false.,error)
  hcct%loca%size = 0
  !
  if (allocated(dsky)) deallocate(dsky)
  call sic_delvariable ('SKY',.false.,error)
  hsky%loca%size = 0
end subroutine new_dirty_beam
!
subroutine map_beams(task,map_beam,huv,nx,ny,nb,nc)
  use gbl_message
  use image_def
  use clean_default
  use imager_interfaces, only : t_channel_sampling, map_message
  !-------------------------------------------------------------
  ! @ private
  !
  !*   
  ! IMAGER -- BEAM Utility  
  !   Define number of dirty beams.
  !
  !   Define dirty beams number according to user specification
  !   and UV table characteristics. The control code indicates
  !   the goal.  
  !     -1    Automatic guess to avoid resolution effects  
  !      0    One beam for all, if possible  
  !     >0    Number of adjacents channels sharing same beam  
  !  Code -2 was for debugging only
  !!
  !-------------------------------------------------------------
  character(len=*), intent(in) :: task      !! Caller name
  integer, intent(out) :: map_beam          !! Number of channels per beam 
  type(gildas), intent(in) :: huv           !! UV Header
  integer, intent(in) :: nx                 !! X size
  integer, intent(in) :: ny                 !! Y size
  integer, intent(in) :: nc                 !! Number of channels
  integer, intent(out) :: nb                !! Number of beams
  !
  ! Local ---
  character(len=80) :: chain
  !
  ! Code ----
  map_beam = default_map%beam     ! Mapped to BEAM_STEP variable
  !
  if (map_beam.eq.-2) then
    nb = 1
    call map_message(seve%w,task,'You are using an obsolete BEAM_STEP value',seve%w)
  else
    !
    if (map_beam.eq.-1) then
      call t_channel_sampling(task,huv,map_beam,min(nx,ny))
      nb = (nc+map_beam-1)/map_beam       
      map_beam = (nc+nb-1)/nb
    endif
    !
    ! Round-off odd cases
    if (map_beam.eq.0) then
      nb = 1
      map_beam = nc
    else
      nb = (nc+map_beam-1)/map_beam
      map_beam = (nc+nb-1)/nb
    endif
    if (nb.eq.1) then
      chain = 'Producing a single beam for all channels'
    else
      write(chain,'(A,I4,A,I0,A,I0,A)') 'Producing one beam every ',map_beam, &
        &   ' channels, total ',nb,' beams for ',nc,' channels'
    endif
    call map_message(seve%i,task,chain)
  endif
end subroutine map_beams
!
subroutine channel_range(rname,fchan,lchan,icode,nbr,branges)
  use gkernel_interfaces
  use gkernel_types
  use gbl_message
  use clean_beams
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- BEAM Utility  
  ! Verify the channel ranges and restrict to most signifcant.
  !
  !   If UV_CHECK BEAM has been used, restrict the range to the 
  ! most significant one (to avoid issues with bad edge recognition)
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname   !! Caller name
  integer, intent(inout) :: fchan         !! First channel
  integer, intent(inout) :: lchan         !! Last channel
  integer, intent(inout) :: icode         !! Integer error code
  integer, intent(out) :: nbr             !! Number of effective ranges
  integer, intent(inout) :: branges(2,*)  !! Beam ranges
  !
  ! Constants
  real, parameter :: tol=1e-4 
  !
  ! Local ---
  integer :: krange, mrange, nrange, frange, lrange
  integer :: i, ichan, jchan
  integer, allocatable :: ranges(:), irptr(:)
  real :: weight, aweig
  character(len=120) :: chain
  !
  ! Code ----
  icode = 0
  nbr = 0
  if (nbeam_ranges.le.0) return
  !
  allocate(ranges(nbeam_ranges),irptr(nbeam_ranges),stat=icode)
  if (icode.ne.0) return
  do i=1,nbeam_ranges
    ranges(i) = beam_ranges(2,i)-beam_ranges(1,i)
  enddo
  !
  ! Ignore the small gap (< beam_gap channels) regions that may occur
  ! between regions of identical weights.
  mrange = beam_gap
  !
  nrange = 0
  frange = nbeam_ranges
  lrange = 1
  weight = 0.
  do i=1,nbeam_ranges 
    if (ranges(i).gt.mrange) then
      aweig = beam_ranges(3,i) ! Local weight !! *ranges(i) ! Total weight
      if ((weight.eq.0).or.(abs(aweig-weight).gt.tol*weight)) then
        ! Range has new weight
        weight = aweig
        krange = i
        nrange = nrange+1
        irptr(nrange) = krange
        frange = min(i,frange) 
        lrange = max(i,lrange)
        branges(1:2,nrange) = beam_ranges(1:2,i)
      else
        lrange = max(i,lrange)  ! Range has same weight than previous ones, gaps ignored
        branges(2,nrange) = beam_ranges(2,i)
      endif
    else if (i.ne.nbeam_ranges) then
      write(chain,'(A,I0,A,I0,A,I0)') 'Ignoring differing weights in BEAM_RANGE #', &
        & i,', channels ',nint(beam_ranges(1,i)),' to ',nint(beam_ranges(2,i))
      call map_message(seve%w,rname,chain)
    endif
  enddo
  !
  ! But fall back to more detailed range if NRANGE is Zero at this stage
  if (nrange.eq.0) then
    frange = nbeam_ranges
    lrange = 1
    do i=1,nbeam_ranges 
      krange = i
      nrange = nrange+1
      frange = min(i,frange) 
      lrange = max(i,lrange)
      branges(1:2,nrange) = beam_ranges(1:2,i)
    enddo
  endif
  nbr = nrange
  !
  ichan = beam_ranges(1,frange)
  ichan = max(ichan,fchan)
  jchan = beam_ranges(2,lrange)
  if (lchan.ne.0) jchan = min(lchan,jchan)
  if ((ichan.eq.fchan).and.(jchan.eq.lchan)) then
    return ! No change is good
  endif
  !
  fchan = ichan
  lchan = jchan
  if (nrange.gt.1)  then 
    ! Several Beams: Take First and Last range ends, but issue a clear warning
    call map_message(seve%w,rname,'More than 1 significant beam regions',seve%e)
    write(chain,'(A,I0,A,I0,A,I0,A,I0,A)') 'Channel range restricted to [',fchan,',',lchan, &
      & '] from BEAM_RANGES[',frange,'] and BEAM_RANGES[',lrange,']'
    call map_message(seve%w,rname,chain,seve%w)
  else 
    !TEST!  if (frange.ne.lrange) print *,'Strange case Frange ',frange,' Lrange ',lrange
    write(chain,'(A,I0,A,I0,A,I0,A,I0,A)') 'Channel range restricted to [',fchan,',',lchan, &
      & '] from BEAM_RANGES[',frange,'] and [',lrange,']'
    call map_message(seve%i,rname,chain)
  endif
  !
  icode = 0
end subroutine channel_range
!
subroutine define_beams(task,map_beam,nx,ny,huv,mcol,nb,error)
  use image_def
  use clean_default
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  !*
  ! IMAGER -- BEAM Utility  
  ! Define the number of beams according to the BEAM_STEP variable
  ! and number of data channels.
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: task   !! Caller name
  integer, intent(in) :: nx              !! X size
  integer, intent(in) :: ny              !! Y size
  integer, intent(inout) :: map_beam     !! Desired number of channels per beams
  type(gildas), intent(in) :: huv        !! UV data
  integer, intent(inout) :: mcol(2)      !! Channel range
  integer, intent(out) :: nb             !! Number of beams
  logical, intent(out) :: error          !! Logical Error Flag
  !
  ! Local ---
  integer :: nc         ! Number of channels
  integer :: icode
  character(len=120) :: chain
  !
  ! Code ----
  nc = mcol(2)-mcol(1)+1
  !
  ! Find out how many beams are required
  map_beam = default_map%beam     ! Mapped to BEAM_STEP variable
  !
  if (map_beam.eq.-2) then
    nb = 1
    call map_message(seve%w,task,'You are using an obsolete BEAM_STEP value',seve%w)
  else if (map_beam.le.0) then
    !
    if (map_beam.eq.-1) then
      call t_channel_sampling(task,huv,map_beam,min(nx,ny))
      nb = (nc+map_beam-1)/map_beam       
      map_beam = (nc+nb-1)/nb
    endif
    !
    ! Round-off odd cases
    if (map_beam.eq.0) then
      nb = 1
      map_beam = nc
    else
      nb = (nc+map_beam-1)/map_beam
      map_beam = (nc+nb-1)/nb
    endif
    if (nb.eq.1) then
      chain = 'Producing a single beam for all channels'
    else
      write(chain,'(A,I4,A,I0,A,I0,A)') 'Producing one beam every ',map_beam, &
        &   ' channels, total ',nb,' beams for ',nc,' channels'
    endif
  else
    nb = (nc+map_beam-1)/map_beam
  endif
  !
  ! Verify the beam ranges
  if (map_beam.ne.1) call check_beams_mem(error)     ! Check beam consistency if needed
  call verify_beam_ranges(task,map_beam,mcol,icode) !! ,default_map%beam)
  if (icode.eq.-1) then
    call map_message(seve%e,task,'Beam consistency is unknown, use UV_CHECK first')
    error = .true.
    return
  else if (icode.eq.1) then
    write(chain,'(A,I0,A)') 'Number of channels per beam ', map_beam, &
    ' does not fit in BEAM_RANGES'
    if (default_map%beam.eq.-1) then
      map_beam = 1
      nb = nc
      call map_message(seve%w,task,chain)
    else if (default_map%beam.eq.-2) then
      nb = 1     ! Pick up any beam
      call map_message(seve%w,task,'User forced a common beam by BEAM_STEP = -2')
    else
      call map_message(seve%e,task,chain,seve%e)
      call map_message(seve%i,task,'Use LET BEAM_STEP -1 to allow one beam per channel')
      error = .true.
      return
    endif
  endif
  !
  if (nb.eq.1) then
    chain = 'Producing a single beam for all channels'
  else if (map_beam.eq.1) then
    chain = 'Producing one beam per channel' 
    call map_message(seve%i,task,chain,seve%w)
    return
  else
    write(chain,'(A,I4,A,I0,A,I0,A)') 'Producing one beam every ',map_beam, &
      &   ' channels, total ',nb,' beams for ',nc,' channels'
  endif
  call map_message(seve%i,task,chain)
end subroutine define_beams
!
subroutine verify_beam_ranges(task,mbeam,mcol,icode)
  use gbl_message
  use clean_beams 
  use imager_interfaces, only : map_message, channel_range
  !---------------------------------------------------------------------
  !   @ private
  !*
  ! IMAGER --  BEAM utility  
  ! Verify that the selected channel range is consistent 
  ! with required number of beams.
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: task    !! Calling command
  integer, intent(in) :: mbeam            !! Number of planes per beam
  integer, intent(inout) :: mcol(2)       !! Channel range
  integer, intent(out) :: icode           !! Returned Error Code (-1 No check done, 
  !
  ! Local ---
  character(len=80) :: chain
  integer :: i, nc, nbr
  integer, allocatable :: branges(:,:)
  !
  ! Code ----
  icode = 0
  !
  if (mbeam.eq.1) return          ! One beam per plane, no problem
  if (nbeam_ranges.lt.0) then     ! No verification performed yet
    icode = -1                    ! Return error code
    return
  endif
  if (nbeam_ranges.eq.0) return   ! No beam range, no problem
  !
  ! ! Print *,'MCOL on entry ',mcol
  allocate(branges(2,nbeam_ranges))
  call channel_range(task,mcol(1),mcol(2),icode,nbr,branges) !! frange,lrange)
  if (icode.ne.0) return
  !
  if (mbeam.eq.0) then            ! Only 1 beam in total  OR
    ! Only 1 range: does it contain the imaged region ?
    ! Verify MCOL is included in one of the Beam Ranges
    do i=1,nbr
      if (mcol(1).ge.branges(1,i) .and. mcol(2).le.branges(2,i)) then
        return
      endif
    enddo
    !
  else
    !
    ! The algorithm is more complex. A solution is possible if the
    ! grid defined by the Channels per beam matches MCOL, but that is
    ! tricky to verify.
    !
    ! One may build the grid MCOL[1], MCOL[1]+MBEAM, ... MCOL[2]
    ! and figure out if BEAM_RANGES fall on that grid
    do i=1,nbr
      if (branges(1,i).le.mcol(1) .and. branges(2,i).ge.mcol(2)) then
        ! Everything is in one beam Range
        nc = mcol(2)-mcol(1)+1
        if (nc.lt.mbeam) then
          ! Less channels than "Channels per Beam"
          return ! It works, just return
        else if (mod(nc,mbeam).eq.0) then
          ! An integer number of beams, it works too
          return
        else
          write(chain,'(A,I0,A,I0,A,I0,A)') 'Beam Range #',i, &
          & ' includes Channel range [',mcol(1),',',mcol(2),']'
          call map_message(seve%w,task,chain,seve%w)
        endif
      endif
    enddo
    !
    ! There could be other matches, but they are more complex.
    !   Leave them as an error so far
    icode = 1
    !
    ! The other option is to adjust MBEAM (which then should be INOUT)
    ! to 1 channel per beam, but that makes a big difference in
    ! image size... Also, synthesized beams can be quite different
    ! in this case
  endif
end subroutine verify_beam_ranges
