 
! A number of tools for UV_MAP to control the Image headers
! and the range of channels being processed
!
subroutine uvmap_cols(task,line,huv,channels,error)
  use image_def
  use clean_def
  use gkernel_interfaces, only : sic_present, sic_get_inte, sic_ambigs
  !---------------------------------------------------------------------
  ! IMAGER
  !   @ private
  !     Define the channel range, Weight channel, and Channel defining 
  !     the observing frequency
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: task  !! Callers name
  character(len=*), intent(in) :: line  !! Command line with /RANGE option
  type(gildas), intent(in) :: huv       !! UV data header
  type(channel_par), intent(inout) :: channels   !! Channels to be used
  logical, intent(out) :: error         !! Error flag
  !
  integer, parameter :: o_range=3       ! For UV_MAP
  integer :: mcol(2)     ! Ordered channel min max
  integer :: wcol        ! Weight channel
  real(8) :: rcol        ! Channel defining the frequency
  integer :: nc, fcol, lcol
  real(8) :: drange(2)
  character(len=12) :: csort
  integer(kind=4), parameter :: msort=3
  integer :: isort, nn
  character(len=12) :: types(msort),mysort
  data types /'CHANNEL','VELOCITY','FREQUENCY'/
  !
  nc = huv%gil%nchan
  wcol = 0
  rcol = 0.0
  !
  ! Backward compatibility
  call sic_get_inte('WCOL',wcol,error)
  call sic_get_inte('MCOL[1]',mcol(1),error)
  call sic_get_inte('MCOL[2]',mcol(2),error) 
  call sic_get_dble('RCOL',rcol,error) 
  !
  error = .false.
  if (mcol(1).eq.0) then
    mcol(1) = 1
  else
    mcol(1) = max(1,min(mcol(1),nc))
  endif
  if (mcol(2).eq.0) then
    mcol(2) = nc
  else
    mcol(2) = max(1,min(mcol(2),nc))
  endif
  !
  ! /RANGE (for flexibility)
  if (sic_present(o_range,0)) then
    call sic_r8 (line,o_range,1,drange(1),.true.,error)
    if (error) return
    call sic_r8 (line,o_range,2,drange(2),.true.,error)
    if (error) return
    call sic_ke (line,o_range,3,csort,nn,.true.,error)
    if (error) return
    error = .false.
    call sic_ambigs(task,csort,mysort,isort,types,msort,error)
    if (error)  return
    call out_range(task,csort,drange,mcol,huv,error)
    if (error) return
  endif
  fcol = min(mcol(1),mcol(2))
  lcol = max(mcol(1),mcol(2))
  nc = lcol-fcol+1
  mcol(1) = fcol
  mcol(2) = lcol
  !
  ! Do not use the center channel (some times flagged)
  if (wcol.eq.0) then
    wcol = fcol+nc/3
  else
    wcol = max(1,wcol)
    wcol = min(wcol,huv%gil%nchan)
  endif
  !
  if (rcol.eq.0) then
    rcol = dble(fcol+lcol)*0.5d0
  else
    rcol = max(1.d0,rcol)
    rcol = min(rcol,dble(huv%gil%nchan))
  endif
  !
  channels%bounds = mcol
  channels%weight = wcol
  channels%freq   = rcol
end subroutine uvmap_cols
!
subroutine map_copy_par(in,out)
  use clean_def
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER -- Utility routine
  !
  !   Copy a MAP structure to another one, but avoid erasing
  !   the number of fields in it. The result must have an intent(inout)
  !   to avoid erasing the allocatable array in the derived type.
  !!
  !---------------------------------------------------------------------
  type(uvmap_par), intent(in) :: in
  type(uvmap_par), intent(inout) :: out
  !
  out%taper = in%taper         !! UV Taper
  out%size = in%size           !! Map size
  out%xycell = in%xycell       !! Map cell
  out%uvcell = in%uvcell       !! UV cell
  out%uniform = in%uniform     !! Weighting parameters
  out%wcol = in%wcol           !! Weighting channel
  out%ctype = in%ctype         !! Convolution mode
  out%support = in%support     !! Support of gridding function
  out%beam = in%beam           !! One beam every N channels
  out%field = in%field         !! Field of view in arcsecond
  out%precis = in%precis       !! Precision at map edges
  out%mode = in%mode           !! Weighting mode
  out%shift = in%shift         !! Shift or rotate UV data
  out%ra_c = in%ra_c           !! Right ascension
  out%dec_c = in%dec_c         !! Declination
  out%angle = in%angle         !! New position angle of UV data
  out%truncate = in%truncate   !! Truncation radius
  !
end subroutine map_copy_par
!
subroutine map_prepare(task,huv,map,error)
  use image_def
  use clean_def
  use clean_default
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER  -- Support for UV_MAP
  !   
  !             Prepares the imaging parameters from the UV data header
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: task  !! Caller name
  type(gildas), intent(in) :: huv       !! UV data header
  type(uvmap_par), intent(inout) :: map !! Imaging parameters
  logical, intent(out) :: error         !! Error flag
  !
  ! Constants
  ! character(len=*), parameter :: obsol='obsolete'   ! Later
  character(len=*), parameter :: obsol='obsolescent'
  !
  ! Local ---
  character(len=80) :: chain
  character(len=6) :: cmode
  real :: fact
  !
  ! Code -----
  !
  ! Check version
  if (map_version.lt.-1 .or. map_version.gt.1) then
    call map_message(seve%e,task,'Invalid MAP_VERSION, should be -1,0 or 1')
    error = .true.
    return
  endif
  !
  ! Check old syntax
  if (old_map%uniform(1).ne.save_map%uniform(1)) then
    call map_message(seve%w,task,'UV_CELL is '//obsol//', use MAP_UVCELL instead')
    default_map%uniform(1) = old_map%uniform(1)
  endif
  if (old_map%uniform(2).ne.save_map%uniform(2)) then
    call map_message(seve%w,task,'UV_CELL is '//obsol//', use MAP_ROBUST instead')
    default_map%uniform(2) = old_map%uniform(2)
  endif
  if (old_map%taper(4).ne.save_map%taper(4)) then
    call map_message(seve%w,task,'TAPER_EXPO is '//obsol//', use MAP_TAPER_EXPO instead')
    save_map%taper(4) = old_map%taper(4)
    default_map%taper(4) = old_map%taper(4)
  endif
  if (any(old_map%taper.ne.save_map%taper)) then
    call map_message(seve%w,task,'UV_TAPER is '//obsol//', use MAP_UVTAPER instead')
    default_map%taper = old_map%taper
  endif
  if (old_map%ctype.ne.save_map%ctype) then
    call map_message(seve%w,task,'CONVOLUTION is '//obsol//', use MAP_CONVOLUTION instead')
    default_map%ctype = old_map%ctype
  endif
  if (old_map%mode.ne.save_map%mode) then
    call map_message(seve%w,task,'WEIGHT_MODE is '// &
      & 'obsolete, set MAP_ROBUST=0 instead') 
    ! Attempt to catch the Natural case
    call get_weightmode(task,old_map%mode,error)
    if (old_map%mode.eq.'NATURAL') default_map%uniform(2) = 0.0
    default_map%mode = old_map%mode
  endif
  if (old_map%shift.neqv.save_map%shift) then
    call map_message(seve%w,task,'UV_SHIFT is '//obsol//', use MAP_SHIFT instead')
    default_map%shift = old_map%shift
  endif
  !
  ! Copy the current default to the actual structure
  call map_copy_par(default_map,map)
  !
  ! Weighting scheme
  error = .false.
  map%uniform(1) = max(0.0,map%uniform(1))
  if (map%uniform(2).ne.0) then
    if (huv%gil%nteles.gt.0) then
      if (map%uniform(2).gt.0) then
        cmode = 'Robust'
        fact = 2.0
      else
        cmode = 'Briggs'
        fact = 1.0
      endif
      if (map%uniform(1).eq.0) then
        map%uniform(1) = huv%gil%teles(1)%diam/fact 
        write(chain,'(A,A,F6.2,A,F6.2)') cmode,' weighting ',map%uniform(2),' with UV cell size ',map%uniform(1)
        call map_message(seve%i,task,chain)
      else if (map%uniform(1).gt.huv%gil%teles(1)%diam/fact) then
        write(chain,'(A,A,F6.2,A,F6.2)') cmode,' weighting ',map%uniform(2),' with UV cell size ',map%uniform(1)
        call map_message(seve%i,task,trim(chain)//' (super-uniform)')
      endif
    else if (map%uniform(1).eq.0) then
      call map_message(seve%e,task, &
      & 'No UV cell size and no Telescope defined, use SPECIFY TELESCOPE or LET MAP_UVCELL Value')
      error = .true.
    endif
  endif
  !
  ! Here, we do not care about the fields issue
  old_map = default_map
  save_map = default_map
end subroutine map_prepare
!
subroutine uvmap_headers(huv,nx,ny,nb,ns,map,mcol,hbeam,hdirty,error)
  use clean_def
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER -- Utility routine
  !
  !   Define the Beam and Dirty image headers 
  !!
  !---------------------------------------------------------------------
  integer, intent(in) :: nx,ny           !! Map size
  integer, intent(in) :: ns              !! Number of channels per single beam
  integer, intent(in) :: nb              !! Number of beams
  integer, intent(in) :: mcol(2)         !! Channel range
  type (uvmap_par), intent(in) :: map    !! Mapping parameters
  type(gildas), intent(in) :: huv        !! UV headers
  type(gildas), intent(inout) :: hbeam   !! Beam headers
  type(gildas), intent(inout) :: hdirty  !! Dirty image header
  logical, intent(inout) :: error
  !
  ! Local ---
  integer :: nc   ! Number of channels
  integer :: i
  integer :: fcol
  real(8) :: vref,voff,vinc
  real(4) :: loff,boff
  !
  ! Code ----
  nc = huv%gil%nchan
  vref = huv%gil%ref(1)
  voff = huv%gil%voff
  vinc = huv%gil%vres
  !
  error = .false.
  if (mcol(1).gt.mcol(2)) error = .true.
  do i=1,2
    if (mcol(i).lt.1 .or. mcol(i).gt.nc) then
      error = .true.
    endif
  enddo
  if (error) then
    Print *,'F-UVMAP_HEADERS,  MCOL not initialized ',mcol
    return
  endif
  !
  nc = mcol(2) - mcol(1)+1
  fcol = mcol(1)
  !
  ! Make beam, not normalized
  call gdf_copy_header(huv,hbeam,error)
  hbeam%gil%dopp = 0    ! Nullify the Doppler factor
  !
  hbeam%gil%ndim = 3
  hbeam%gil%dim(1) = nx
  hbeam%gil%dim(2) = ny
  hbeam%gil%dim(3) = nb
  hbeam%gil%dim(4) = 1
  hbeam%gil%convert(1,1) = nx/2+1
  hbeam%gil%convert(1,2) = ny/2+1
  hbeam%gil%convert(2,1) = 0
  hbeam%gil%convert(2,2) = 0
  hbeam%gil%convert(3,1) = -map%xycell(1)  ! Assume EQUATORIAL system
  hbeam%gil%convert(3,2) = map%xycell(2)
!    hbeam%gil%convert(1,3) = vref-fcol+1     ! for 1 per channel
! From UV_COMPRESS
!    uvout%gil%inc(1) = uvout%gil%inc(1)*nc
!    uvout%gil%ref(1) = (2.0*uvout%gil%ref(1)+nc-1.0)/2/nc
!    uvout%gil%vres = nc*uvout%gil%vres
!    uvout%gil%fres = nc*uvout%gil%fres
!
  hbeam%gil%convert(1,3) = (2.d0*(vref-fcol)+ns+1.d0)/2/ns ! Correct
  hbeam%gil%convert(2,3) = voff
  hbeam%gil%blan_words = 0        ! No blanking test SG
  hbeam%gil%extr_words = 0
  hbeam%gil%reso_words = 0
  hbeam%gil%uvda_words = 0
  hbeam%gil%type_gdf = code_gdf_image
  !
  hbeam%char%code(1) = 'ANGLE'
  hbeam%char%code(2) = 'ANGLE'
  hbeam%char%code(3) = 'VELOCITY'
  hbeam%gil%majo = 0.0
  hbeam%loca%size = hbeam%gil%dim(1)*hbeam%gil%dim(2)*hbeam%gil%dim(3)
  !
  ! Also define the Projection, for a better "show beam"
  hbeam%gil%proj_words = def_proj_words
  hbeam%char%code(1) = 'RA'
  hbeam%char%code(2) = 'DEC'
  hbeam%char%code(3) = 'VELOCITY'
  call equ_to_gal(hbeam%gil%ra,hbeam%gil%dec,0.0,0.0,   &
                  hbeam%gil%epoc,hbeam%gil%lii,hbeam%gil%bii,loff,boff,error)
  if (huv%gil%ptyp.eq.p_none) then
    hbeam%gil%ptyp = p_azimuthal  ! Azimuthal (Sin)
    hbeam%gil%pang = 0.d0     ! Defined in table.
    hbeam%gil%a0 = hbeam%gil%ra
    hbeam%gil%d0 = hbeam%gil%dec
  else
    hbeam%gil%ptyp = p_azimuthal
    hbeam%gil%pang = huv%gil%pang ! Defined in table.
    hbeam%gil%a0 = huv%gil%a0
    hbeam%gil%d0 = huv%gil%d0
  endif
  if (hbeam%char%syst.eq.' ') hbeam%char%syst = 'EQUATORIAL'
  hbeam%gil%xaxi = 1
  hbeam%gil%yaxi = 2
  hbeam%gil%faxi = 3  
  !
  ! Prepare the dirty map header
  call gdf_copy_header(hbeam,hdirty,error)
  hdirty%gil%ndim = 3
  hdirty%gil%dim(1) = nx
  hdirty%gil%dim(2) = ny
  hdirty%gil%dim(3) = nc
  hdirty%gil%dim(4) = 1
  hdirty%gil%convert(1,3) = vref-fcol+1
  hdirty%gil%convert(2,3) = voff
  hdirty%gil%convert(3,3) = vinc
  hdirty%gil%proj_words = def_proj_words
  hdirty%gil%uvda_words = 0
  hdirty%gil%type_gdf = code_gdf_image
  hdirty%char%code(1) = 'RA'
  hdirty%char%code(2) = 'DEC'
  hdirty%char%code(3) = 'VELOCITY'
  call equ_to_gal(hdirty%gil%ra,hdirty%gil%dec,0.0,0.0,   &
                  hdirty%gil%epoc,hdirty%gil%lii,hdirty%gil%bii,loff,boff,error)
  if (huv%gil%ptyp.eq.p_none) then
    hdirty%gil%ptyp = p_azimuthal  ! Azimuthal (Sin)
    hdirty%gil%pang = 0.d0         ! Defined in table.
    hdirty%gil%a0 = hdirty%gil%ra
    hdirty%gil%d0 = hdirty%gil%dec
  else
    hdirty%gil%ptyp = p_azimuthal
    hdirty%gil%pang = huv%gil%pang ! Defined in table.
    hdirty%gil%a0 = huv%gil%a0
    hdirty%gil%d0 = huv%gil%d0
  endif
  hdirty%gil%xaxi = 1
  hdirty%gil%yaxi = 2
  hdirty%gil%faxi = 3
  hdirty%gil%blan_words = 0        ! No blanking test SG
  hdirty%gil%extr_words = 0        ! extrema not computed
  hdirty%gil%reso_words = 0        ! no beam defined
  hdirty%gil%nois_words = 2
  hdirty%gil%majo = 0
  hdirty%char%unit = 'Jy/beam'
  hdirty%loca%size = hdirty%gil%dim(1)*hdirty%gil%dim(2)*hdirty%gil%dim(3)
  !
  ! Smooth the beam in Frequency
  hbeam%gil%convert(3,3) = vinc*ns
  hbeam%gil%vres = ns*vinc
  hbeam%gil%fres = ns*hbeam%gil%fres
  !
end subroutine uvmap_headers

