subroutine feather_comm(line,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  use clean_arrays
  use imager_interfaces, except_this => feather_comm
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for command  
  ! FEATHER [/FILE FileMerge FileHigh FileLow] [/REPROJECT]
  !
  !   Uses  FEATHER_RADIUS
  !         FEATHER_SCALE
  !         FEATHER_RANGE[2]
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line  !! Command line
  logical, intent(out) :: error         !! Logical error flag
  !
  ! Constants
  integer, parameter :: o_file=1
  integer, parameter :: o_reproject=2
  character(len=1), parameter :: question_mark='?'
  character(len=*), parameter :: rname='FEATHER'
  !
  ! Memory -
  type(gildas), save :: hall
  real, save :: feather_radius=15.0
  real, save :: feather_ratio=1.0
  real, save :: feather_expo=8.0
  real, save :: feather_range(2)=[0.,0.]
  logical, save :: feather_init=.true.
  ! Local ---
  real :: actual_range(2)
  logical :: auto
  character(len=filename_length) :: nameh,namel,name_out
  character(len=60) :: argum
  integer :: narg
  integer :: n, ier
  !
  ! Code ----
  error = .false.
  !
  if (feather_init) then
    ! At first call, just initialize and do nothing else
    call sic_def_real('FEATHER_RADIUS',feather_radius,0,0,.false.,error)  
    call sic_def_real('FEATHER_RATIO', feather_ratio,0,0,.false.,error)  
    call sic_def_real('FEATHER_EXPO', feather_expo,0,0,.false.,error)  
    call sic_def_real('FEATHER_RANGE', feather_range,1,2,.false.,error)  
    feather_init = .false.
    return
  endif
  !
  narg = sic_narg(0)
  if (narg.eq.1) then
    call sic_ch(line,0,1,argum,n,.true.,error)
    if (argum(1:1).eq.question_mark) then
      if (argum.eq."?" .or. argum.eq."??" .or. argum.eq."???") then
        call exec_program('@ i_feather')
        return
      endif
    endif
  endif
  !
  if (narg.ne.0) then
    call map_message(seve%e,rname,'FEATHER accepts no argument (except ?)')
    error = .true.
    return
  endif
  !
  ! Set current range
  actual_range = feather_range
  if (feather_range(1).eq.0) actual_range(1) = feather_radius/1.15
  if (feather_range(2).eq.0) actual_range(2) = feather_radius*1.15
  !
  ! Auto reproject
  auto = sic_present(o_reproject,0)
  !
  if (sic_present(o_file,0)) then
    ! File version
    call sic_ch(line,o_file,3,namel,n,.true.,error)
    if (error) return
    call sic_ch(line,o_file,1,name_out,n,.true.,error)
    call sic_ch(line,o_file,2,nameh,n,.true.,error)
    !
    call t_uv_feather(nameh,namel,name_out, &
      & feather_radius,feather_ratio,feather_expo,actual_range,auto,error)
  else 
    ! Default buffer version
    ! Ideally, one would like to specify any buffer, but
    ! we do not know how to set a pointer to a Memory region,
    ! except using Fortran 2008 (which is marginally accepted yet ?)
    if (.not.allocated(dsky)) then
      call map_message(seve%e,rname,'SKY image is not defined')
      error = .true.
    else
      hsky%r3d => dsky
    endif
    if (.not.associated(hshort%r3d)) then
      call map_message(seve%e,rname,'SHORT image is not defined')
      error = .true.
    endif
    if (error) return
    !
    if (associated(hall%r3d)) deallocate(hall%r3d)
    call sic_delvariable ('FEATHERED',.false.,error)
    !
    call gildas_null(hall)
    call gdf_copy_header(hsky,hall,error)
    call gdf_allocate(hall,error)
    if (error) return
    !
    ! Do the job
    call c_uv_feather(hall,hsky,hshort, &
      & feather_radius,feather_ratio,feather_expo,actual_range,auto,error)
    if (error) then
      deallocate(hall%r3d,stat=ier)
      return
    endif
    call sic_mapgildas('FEATHERED',hall,error,hall%r3d)
  endif
end subroutine feather_comm
!
subroutine t_uv_feather(nameh,namel,name_out,uvradius,scale,expo,range, &
  & auto,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, except_this => t_uv_feather
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for command  
  ! FEATHER /FILE FileMerge FileHigh FileLow [/REPROJECT]
  !
  !   Uses  FEATHER_RADIUS
  !         FEATHER_SCALE
  !         FEATHER_RANGE[2]  
  ! "Feather" (in the UV plane) two data cubes from data files
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: nameh      !! HIGHres file name
  character(len=*), intent(in) :: namel      !! LOWres file name
  character(len=*), intent(in) :: name_out   !! Merged file name
  real, intent(in) ::  uvradius              !! Transition radius (m)
  real, intent(in) ::  scale                 !! Scale factor LOW / HIGH
  real, intent(in) ::  expo                  !! Sharpness of transition
  real, intent(in) ::  range(2)              !! Range of overlap (m) 
  logical, intent(in) :: auto                !! Auto reproject
  logical, intent(out) :: error              !! Logical Error flag
  !
  character(len=*), parameter :: rname='FEATHER'
  ! Local ---
  type(gildas) :: high, low, all, htmp
  real :: ratio
  integer :: ier
  integer :: sys_code
  logical :: auto_space
  logical :: err
  !
  ! Code ----
  error = .false.
  ratio = scale
  auto_space = auto
  !
  if (uvradius.eq.0) error = .true.
  if (ratio.eq.0) ratio = 1.0
  if (range(2).le.range(1)) error = .true.
  if (error) then
    call map_message(seve%e,rname,'Invalid FEATHER_* input values')
    return
  endif
  !
  ! Read Headers Model & Image 
  call gildas_null(high)
  call gildas_null(low)
  call gildas_null(all)
  !
  call sic_parse_file (nameh,' ','.lmv-sky',high%file)
  call gdf_read_header (high,error)
  if (error) return
  call sic_parse_file (namel,' ','.lmv-sky',low%file)
  call gdf_read_header (low,error)
  if (error) return
  !
  ier = 0
  call s_uv_consistency (high,low,error,ier)
  !
  if (error) then
    if (ier.eq.0) return ! Spectro error or Swapping error
    !
    ! Space error : reproject LOW on HIGH if requested
    if (auto_space) then
      call map_message(seve%w,rname,'Images do not match, resampling LOWres one')
      continue
    else
      call gdf_close_image(high,err)
      call gdf_close_image(low,err)
      call map_message(seve%e,rname,'Images do not match')
      return
    endif
  else
    auto_space = .false.
  endif
  !
  if (auto_space) then
    call gdf_close_image(low,err)
    call gildas_null(htmp)
    htmp%file = low%file
    call gdf_read_header (htmp,error)
    if (error) return
    call s_reproject_init (htmp,high,low,sys_code,error)
    if (error) return
    call gdf_allocate(low,error)
    if (error) return
    call gdf_allocate(htmp,error)
    if (error) return
    call gdf_read_data(htmp,htmp%r3d,error)
    if (error) return
    call s_reproject_do(htmp,htmp%r3d,low,low%r3d,sys_code,error)
    if (error) return
    call gdf_close_image(htmp,err)
  else
    call gdf_allocate (low,error)
    if (error) return
    call gdf_read_data (low,low%r3d,error)
    if (error) return
    call gdf_close_image(low,err)
  endif
  !
  ! Allocate and Read data - Rank 3 at this stage already...
  call gdf_allocate (high,error)
  if (error) return
  call gdf_read_data (high,high%r3d,error)
  if (error) return
  !
  ! Define output image. Comes from the High Resolution one...
  call gdf_copy_header(high,all,error)
  if (error) return
  call gdf_allocate(all,error)
  if (error) return
  !
  call s_uv_hybrid (high,low,all,uvradius,ratio,expo,range,error)
  if (error) return
  !
  call sic_parse_file (name_out,' ','.lmv-sky',all%file)
  call gdf_write_image(all,all%r3d,error)
  !
  call gdf_close_image(high,err)
  !! Not needed with gdf_write_image call gdf_close_image(all,err)
  !
end subroutine t_uv_feather
!
subroutine c_uv_feather(all,high,low,uvradius,scale,expo,range, &
  & auto,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, except_this => c_uv_feather
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for command  
  ! FEATHER [/REPROJECT]
  !
  !   Uses  FEATHER_RADIUS
  !         FEATHER_SCALE
  !         FEATHER_RANGE[2]
  !
  ! "Feather" (in the UV plane) two internal data cubes (usually the SKY 
  ! and SHORT buffers) and put the result in the FEATHERED buffer.
  !!
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: high           !! HIGHres Gildas header
  type(gildas), intent(in) :: low            !! LOWres Gildas header
  type(gildas), intent(inout) :: all         !! Combined Gildas header
  real, intent(in) ::  uvradius              !! Transition radius (m)
  real, intent(in) ::  scale                 !! Scale factor LOW / HIGH
  real, intent(in) ::  expo                  !! Sharpness of transition
  real, intent(in) ::  range(2)              !! Range of overlap (m) 
  logical, intent(in) :: auto                !! Auto reproject
  logical, intent(out) :: error              !! Logical Error flag
  !
  character(len=*), parameter :: rname='FEATHER'
  !
  ! Local ---
  type(gildas) :: htmp
  real :: ratio
  integer :: ier
  integer :: sys_code
  logical :: auto_space
  !
  ! Code ----
  error = .false.
  ratio = scale
  auto_space = auto
  !
  if (uvradius.eq.0) error = .true.
  if (ratio.eq.0) ratio = 1.0
  if (range(2).le.range(1)) error = .true.
  if (error) then
    call map_message(seve%e,rname,'Invalid FEATHER_* input values')
    return
  endif
  !
  ier = 0
  call s_uv_consistency (high,low,error,ier)
  !
  if (error) then
    if (ier.eq.0) return ! Spectro error or Swapping error
    !
    ! Space error : reproject LOW on HIGH if requested
    if (auto_space) then
      call map_message(seve%w,rname,'Images do not match, resampling LOWres one')
      continue
    else
      call map_message(seve%e,rname,'Images do not match')
      return
    endif
  else
    auto_space = .false.
  endif
  !
  if (auto_space) then
    call gildas_null(htmp)
    call gdf_copy_header(low,htmp,error)
    if (error) return
    call s_reproject_init (low,high,htmp,sys_code,error)
    if (error) return
    call gdf_allocate(htmp,error)
    if (error) return    
    call s_reproject_do (low,low%r3d,htmp,htmp%r3d,sys_code,error)
    if (error) return
    call s_uv_hybrid (high,htmp,all,uvradius,ratio,expo,range,error)
    if (error) return
  else
    call s_uv_hybrid (high,low,all,uvradius,ratio,expo,range,error)
  endif
  !
end subroutine c_uv_feather
!
subroutine s_uv_consistency(high,low,error,ier)
  use image_def
  use gbl_message
  use gkernel_interfaces
  use imager_interfaces, except_this => s_uv_consistency
  !---------------------------------------------------------------------
  ! @ public
  !* 
  ! IMAGER -- Support routine for command FEATHER
  !
  ! Verify data cube spatial consistencies
  !!
  !---------------------------------------------------------------------
  type (gildas), intent(in) :: high          !! High resolution image
  type (gildas), intent(in) :: low           !! Low resolution image
  logical, intent(out) :: error              !! Logical Error flag
  integer, intent(out) :: ier                !! Error code number
  !
  character(len=*), parameter :: rname='FEATHER'
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  !
  character(len=160) :: chain
  real :: tole=1e-4
  logical :: equal
  real(8), dimension(2) :: bhigh, blow, bhinc, blinc
  real(4) :: rhigh, rlow
  !
  integer :: jer
  !
  ! Check spectroscopic consistency
  error = .false.
  !
  ier = 0
  call spectrum_consistency(rname,high,low,tole,error)
  if (error) return
  !
  jer = 0
  !
  ! Test that the HIGH image is the largest one and has the smallest beam
  call gdf_compare_shape (high,low,equal)
  if (.not.equal) then
    call map_message(seve%w,rname,'Images do not match')
    bhinc = abs(high%gil%inc(1:2))*180*3600/pi
    blinc = abs(low%gil%inc(1:2))*180*3600/pi
    bhigh = bhinc * high%gil%dim(1:2)
    blow  = blinc * low%gil%dim(1:2)
    if (any(bhigh.ne.blow)) then
      call map_message(seve%i,rname,'Image                Field (")              Pixel (")             Size')
      write(chain,'(A10,2(2X,F10.3,A,F10.3),I8,A,I7)') 'HIGHres ',bhigh(1),' x',bhigh(2) &
        & ,bhinc(1),' x',bhinc(2),high%gil%dim(1),' x',high%gil%dim(2)
      call map_message(seve%i,rname,chain)
      write(chain,'(A10,2(2X,F10.3,A,F10.3),I8,A,I7)') 'LOWres ',blow(1),' x',blow(2) &
        & ,blinc(1),' x',blinc(2),low%gil%dim(1),' x',low%gil%dim(2)
      call map_message(seve%i,rname,chain)
      jer = 1
    endif
  endif
  rhigh = sqrt(high%gil%majo*high%gil%mino)
  rlow  = sqrt(low%gil%majo*low%gil%mino)
  if (rhigh.ge.rlow) jer = jer+2
  if (jer.ne.0) then
    ier = 0
    if (mod(jer,2).ne.0) then
      call map_message(seve%w,rname,'Field of view of "HIGHres" and "LOWres" images differ')
      ier = 1
      jer = jer/2
    endif
    if (jer.ne.0) then
      call map_message(seve%e,rname,'Resolution of "LOWres" image is better than that of "HIGHres" image')
      call map_message(seve%e,rname,'Consider swapping images !...')
    endif
    error = .true.
  endif
end subroutine s_uv_consistency
!
subroutine s_uv_hybrid(high,low,all,uvradius,ratio,exponent,range,error)
  use image_def
  use gbl_message
  use gkernel_interfaces, no_interface=>fourt
  use imager_interfaces, except_this => expand, and_this=> s_uv_hybrid
  !---------------------------------------------------------------------
  ! @ public
  !*
  ! IMAGER -- Support for command FEATHER  
  !  Perform the feathering using the classical method.
  !
  !   Take HIGH map (high resolution map)  
  !   Take LOW  map (map with shortest spacings)  
  !   Make oversampled Fourier Transform of boths  
  !   Compute the truncation function f(r)  
  !   Make the Truncated compact Fourier Transform, f(r) x T(LOW)  
  !   Make the complement long baseline Fourier Transform, (1-f(r)) x T(HIGH)  
  !   Sum them T(ALL) = f(r) x T(LOW) + (1-f(r)) x T(HIGH)  
  !   Make the inverse Fourier Transform  
  !   Truncate the resulting image to original size and Mask  
  !!
  !---------------------------------------------------------------------
  type (gildas), intent(in) :: high          !! High resolution image
  type (gildas), intent(in) :: low           !! Low resolution image
  type (gildas), intent(inout) :: all        !! Combined image
  real, intent(in) ::  uvradius              !! Transition radius (m)
  real, intent(in) ::  ratio                 !! Scale factor LOW / HIGH
  real, intent(in) ::  exponent              !! Sharpness of transition                
  real, intent(in) ::  range(2)              !! Range of overlap (m) 
  logical, intent(out) :: error              !! Logical Error flag
  !
  ! Constants
  character(len=*), parameter :: rname='FEATHER'
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  !
  ! Local ---
  character(len=80) :: chain
  real, pointer :: dhigh(:,:,:),dlow(:,:,:)
  real, pointer :: dout(:,:,:)
  real, allocatable :: f(:,:), x(:), y(:)
  complex, allocatable :: chigh(:,:), cout(:,:)
  complex, allocatable, target :: clow(:,:)
  complex, pointer :: cbig(:,:)
  real, allocatable :: rmask(:,:), wfft(:)
  !
  integer :: nx,ny,nc,ic,nn,dim(2),ier,mx,my,i,j, expand, no
  real(8) :: lambda
  real :: uinc, vinc, scale
  real :: threshold, expo
  real, allocatable :: flux_ratio(:), flux2(:)
  real :: umin2, umax2, xx, ww
  !
  ! Code ----
  nx = high%gil%dim(1)
  ny = high%gil%dim(2)
  nc = high%gil%dim(3)
  !
  mx = low%gil%dim(1)
  my = low%gil%dim(2)
  !
  dout => all%r3d
  !
  ! Skip blanking - Set it to zero, although this  will unavoidably
  ! cause some ringing issues if there is such a blanking.
  ! A better procedure would be to interpolate to Zero with a scale
  ! length larger than the (HIGHres) Beam size
  if (high%gil%eval.ge.0) then
    allocate(dhigh(high%gil%dim(1),high%gil%dim(2),high%gil%dim(3)), stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    dhigh = high%r3d  ! Copy 
    where (abs(dhigh-high%gil%bval).le.high%gil%eval) dhigh = 0.0
  else
    dhigh => high%r3d ! Pointer
  endif
  if (low%gil%eval.ge.0) then
    allocate(dlow(low%gil%dim(1),low%gil%dim(2),low%gil%dim(3)), stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    dlow = low%r3d
    where (abs(dlow-low%gil%bval).le.low%gil%eval) dlow = 0.0
  else
    dlow => low%r3d
  endif
  ! 
  ! Allocate Fourier space
  allocate (chigh(nx,ny), clow(mx,my), cout(nx,ny), stat=ier) 
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  allocate (f(nx,ny), x(nx), y(ny), wfft(2*max(nx,ny)), stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  nn = 2
  dim = (/nx,ny/)
  !
  ! Get the user units in "m". This is the wavelength !
  lambda = 299792458.d-6/all%gil%freq
  ! Compute the combination factor F
  uinc = lambda / (all%gil%inc(1) * nx) 
  vinc = lambda / (all%gil%inc(2) * ny) 
  write(chain,'(A,F8.2,F8.2,A,F8.2)') 'UV Cell size ',uinc,vinc, &
    & ' transition radius ',uvradius
  call map_message(seve%i,rname,chain)
  !
  uinc = uinc / uvradius
  do i=1,nx/2
    x(i) = (i-1)*uinc
  enddo
  do i=nx/2+1,nx
    x(i) = (i-nx-1)*uinc
  enddo
  x = x**2
  !
  vinc = vinc / uvradius
  do i=1,ny/2
    y(i) = (i-1)*vinc
  enddo
  do i=ny/2+1,ny
    y(i) = (i-ny-1)*vinc
  enddo
  y = y**2
  !	
  ! We apply here a sharp truncation, by a exp(-r^(2*expo)) function
  !
  ! The "natural" combination for Single-Dish plus Interferometer data
  ! would be to use as the combination function the Fourier transform 
  ! of the single-dish Beam. But this does not necessarily apply to
  ! arbitrary images that we handle here...
  !
  ! In particular, the initial images may already include the Short
  ! spacings in some way. 
  !
  expo = exponent
  if (expo.eq.0) expo = 4.0
  threshold = log(huge(1.0))**(1.0/expo)
  write(chain,'(A,F6.2,A,F6.2)') 'Threshold ',threshold,' Exponent ',expo
  call map_message(seve%i,rname,chain)
  !
  do j=1,ny
    do i=1,nx
      f(i,j) = x(i) + y(j)            ! This is r^2
      if (f(i,j).lt.threshold) then   ! It falls to Zero at Threshold   
        f(i,j) = exp(-(f(i,j)**expo)) 
      else
        f(i,j) = 0.0
      endif
    enddo
  enddo
  !
  ! Get space for the Flux scale ratio fit, and compute the mask
  umin2 = (range(1)/uvradius)**2
  umax2 = (range(2)/uvradius)**2
  allocate(flux_ratio(nc),flux2(nc),rmask(nx,ny),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  no = 0
  do j=1,ny
    do i=1,nx
      rmask(i,j) = x(i) + y(j)            ! This is r^2
      if (rmask(i,j).gt.umin2 .and. rmask(i,j).lt.umax2) then     
        rmask(i,j) = 1.0
        no = no+1
      else
        rmask(i,j) = 0.0 ! Not f(i,j)
      endif
    enddo
  enddo
  !
  expand = (nx*ny)/(mx*my)
  if (expand.ne.1) then
    allocate(cbig(nx,ny),stat=ier)  
  endif
  !
  ! Get the beams and rescale the data accordingly
  !! Print *,'Computed F, Expand ',expand
  !
  scale = (high%gil%majo*high%gil%mino)/(low%gil%majo*low%gil%mino)
  !
  !$OMP PARALLEL DEFAULT(NONE) &
  !$OMP & SHARED(nc, dhigh,dlow,dout, high,low, f, rmask, flux_ratio, flux2)   &
  !$OMP & SHARED(nx,ny, mx,my, scale, ratio, expand) &
  !$OMP & PRIVATE(ic, chigh,clow,cbig,cout, dim,wfft, i,j)
  !
  !$OMP DO
  do ic = 1,nc
    !! Print *,'IC ',ic
    chigh(:,:) = cmplx(dhigh(:,:,ic),0.0)
    clow(:,:) = cmplx(dlow(:,:,ic),0.0)
    dim = (/nx,ny/)
    call fourt (chigh,dim,2,1,1,wfft)
    !
    ! LOWres
    dim = (/mx,my/)
    call fourt (clow,dim,2,1,1,wfft)
    !
    ! Multiply by the other beam
    call mulgau(clow,mx,my, &
    high%gil%majo,high%gil%mino,high%gil%posa*180.0/real(pi), &
    1.0,real(low%gil%inc(1)),real(low%gil%inc(2)),-1) 
    !
    ! Divide by its own beam - order matters...
    call mulgau(clow,mx,my, &
    low%gil%majo,low%gil%mino,low%gil%posa*180.0/real(pi), &
    1.0,real(low%gil%inc(1)),real(low%gil%inc(2)),1) 
    !
    clow = clow * scale * ratio
    !
    ! Expansion part
    if (expand.ne.1) then
      cbig = 0
      ! Load inner quarter
      do j=1,my/2
        cbig(1:mx,j) = clow(1:mx,j)
        cbig(1+nx-mx/2:nx,j) = clow(mx/2+1:mx,j)
      enddo
      do j=my/2+1,my
        cbig(1:mx,j+ny-my) = clow(1:mx,j)
        cbig(1+nx-mx/2:nx,j+ny-my) = clow(mx/2+1:mx,j)
      enddo
      cbig = cbig*expand ! rescale to appropriate units
    else
      cbig => clow
    endif
    !
    ! At this stage, we have cbig & chigh in same units.
    ! We can compare their relative intensities in the same
    ! UV Plane region by masking both of them by the overlap
    ! region, and fitting a scale factor.
    !
    ! It does not seem to work well, though, on the Demo example
    ! May be one should use f and 1-f to define the weights, rather
    ! than a simple mask...
    call scale_factor(nx,ny,cbig,chigh,rmask,flux_ratio(ic),flux2(ic))
    !
    cout(:,:) = f * cbig + (1.0-f) * chigh
    !
    ! Back transform
    dim = (/nx,ny/) 
    call fourt (cout,dim,2,-1,1,wfft)
    dout(:,:,ic) = real(cout)
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !
  xx = 0
  ww = 0
  do ic=1,nc
    xx = xx + flux_ratio(ic)*flux2(ic)
    ww = ww + flux2(ic)
  enddo
  if (ww.gt.0) then
    xx = xx/ww
  else
    xx = sum(flux_ratio)/nc
  endif
  write(chain,'(A,F10.3)') 'Weighted flux factor (HIGHres / LOWres) ',xx
  call map_message(seve%i,rname,chain)
  !TEST! Print *,'           actors   ',flux_ratio(1:nc)
  !
  dout = dout / (nx*ny)
  !
  ! Reset the Blanking where the HIGHres had one
  if (high%gil%eval.ge.0) then
    where (abs(high%r3d-high%gil%bval).le.high%gil%eval) dout = all%gil%bval
  endif
  !
  ! Reset the Extrema
  all%loca%size = all%gil%dim(1)*all%gil%dim(2)*all%gil%dim(3)
  call cube_minmax('HYBRID',all,error)
  !
  deallocate (chigh,clow,cout,wfft,f)
end subroutine s_uv_hybrid
!
subroutine extract_real (c,mx,my,r,nx,ny)  
  !-----------------------------------------------------------------
  !!     Extract a Real array from a larger Complex array
  !! while shuffling the quarters 
  !-----------------------------------------------------------------
  integer nx,ny                        !! size of input array
  real r(nx,ny)                        !! input real array
  integer mx,my                        !! size of output array
  complex c(mx,my)                     !! output complex array
  !
  integer kx,ky,lx,ly
  integer i,j
  !
  kx = nx/2+1
  lx = mx/2+1
  ky = ny/2+1
  ly = my/2+1
  !
  do j=1,ny
    do i=1,nx
      r(i,j) = real(c(i-kx+lx,j-ky+ly)) 
    enddo
  enddo
end subroutine extract_real
!
subroutine spectrum_consistency(rname,ima,imb,tole,error)
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for command UV_SHORT & FEATHER 
  !   Verify spectral axis consistency
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname  !! Command name
  type(gildas), intent(in) :: ima        !! First header
  type(gildas), intent(in) :: imb        !! Second header
  real, intent(in) :: tole               !! Spectral tolerance
  logical, intent(out) :: error          !! Logical error flag
  !
  integer :: na, nb, fa, fb
  real :: va, vb
  character(len=message_length) :: mess
  !
  error = .false.
  fa = ima%gil%faxi
  fb = imb%gil%faxi
  !
  ! Number of channels
  na = ima%gil%dim(fa)
  nb = ima%gil%dim(fb)
  !
  if (na.ne.nb) then
    write(mess,*) 'Mismatch in number of channels ',na,nb
    call map_message(seve%w,rname,mess)
    error = .true.
  endif
  !
  ! Do not check spectral axis if only 1 channel
  if (na.eq.1 .and. nb.eq.1) return
  !
  ! Check here the spectral axis mismatch
  if (abs(ima%gil%vres-imb%gil%vres).gt.abs(imb%gil%vres*tole)) then
    write(mess,*) 'Mismatch in spectral resolution ',ima%gil%vres,imb%gil%vres
    call map_message(seve%w,rname,mess)
    error = .true.
  endif
  if (abs(ima%gil%freq-imb%gil%freq).gt.abs(imb%gil%fres*tole)) then
    write(mess,*) 'Mismatch in frequency axis ',ima%gil%freq,imb%gil%freq
    call map_message(seve%w,rname,mess)
    error = .true.
  endif
  !
  ! Velocity should be checked too
  va = (1.d0-ima%gil%ref(fa))*ima%gil%vres + ima%gil%voff
  vb = (1.d0-imb%gil%ref(fb))*imb%gil%vres + imb%gil%voff
  if (abs(va-vb).gt.abs(imb%gil%vres*tole)) then
    write(mess,*) 'Mismatch in velocity axis ',va, vb 
    call map_message(seve%w,rname,mess)
    error = .true.
  endif
end subroutine spectrum_consistency
!
subroutine scale_factor(nx,ny,cbig,chigh,rmask,fscale,flux) 
  !*
  !  Compute best fit scaling factor for overlapping regions
  ! of visibilities.
  !
  integer, intent(in) :: nx,ny
  !! FFT of image size
  complex, intent(in) :: cbig(nx,ny)
  !! First FFT
  complex, intent(in) :: chigh(nx,ny)
  !! Second FFT
  real, intent(in) :: rmask(nx,ny)
  !! Masked regions
  real, intent(out) :: fscale
  !! Scale factor
  real, intent(out) :: flux
  !! Weight of scale factor
  !
  ! Local ---
  integer :: ix,iy
  real(kind=8) :: xx, xy, dx, dy
  !
  ! Code ----
  !
  !  Linear fit of flux scale factor - Unweighted - Makes no sense
  ! on noisy data...
  !
  ! A = Sum (X Y / sigma^2) / Sum (X^2/Sigma^2)
  ! A = Sum (X Y W) / Sum (X X W)
  !
  xx = 0
  xy = 0
  !
  do iy=1,ny
    do ix=1,nx
      if (rmask(ix,iy).ne.0.) then
        ! Real part
        dx = real(cbig(ix,iy))**2 + imag(cbig(ix,iy))**2
        dy = real(chigh(ix,iy))*real(cbig(ix,iy)) + imag(chigh(ix,iy))*imag(cbig(ix,iy)) 
        !
        ! Compare only where there is a chance to have a significant signal, i.e.
        ! when the DY is close enough to DX - Assume scale is reasonable to first order
        if (dy.gt.0 .and. abs(dy/dx).gt.0.5*dx) then
          xx = xx + dx
          xy = xy + dy
        endif
        !
        ! Imaginary parts
        dx = 2*real(cbig(ix,iy))*imag(cbig(ix,iy))
        dy = real(chigh(ix,iy))*imag(cbig(ix,iy)) + imag(chigh(ix,iy))*real(cbig(ix,iy)) 
        if (dx.gt.0) then
          if (dy.gt.0 .and. abs(dy/dx).gt.0.5*dx) then
            xx = xx + dx
            xy = xy + dy
          endif
        else
          if (dy.lt.0 .and. abs(dy/dx).gt.0.5*dx) then
            xx = xx - dx
            xy = xy - dy
          endif
        endif
      endif
    enddo
  enddo
  ! ! Print *,'Fscale ',xy,' Flux ',xx,' Ratio ',xy/xx
  if (xx.ne.0.) then
    fscale = xy/xx
    flux   = xx
  else
    fscale = 1.
    flux = 0.
  endif
end subroutine scale_factor
