!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine define_sic_xymap(error)
  use gildas_def
  use gkernel_interfaces
  use xymap_def
  !---------------------------------------------------------------------
  ! @ private
  ! MAP Internal routine
  !---------------------------------------------------------------------
  logical, intent(out) :: error     ! Error status
  !
  if (.not.sic_varexist('map')) then
     call sic_defstructure('map%',.true.,error)
     call sic_def_char('map%tele',sic_xymap_user%tele,.false.,error)
     call sic_def_real('map%diam',sic_xymap_user%diam,0,0,.false.,error)
     call sic_def_real('map%beam',sic_xymap_user%beam,0,0,.false.,error)
     call sic_def_real('map%support',sic_xymap_user%support,1,2,.false.,error)
     call sic_def_inte('map%ctype',sic_xymap_user%ctype,0,0,.false.,error)
     call sic_def_char('map%like',sic_xymap_user%like,.false.,error)
     call sic_def_inte('map%ptype',sic_xymap_user%ptype,0,0,.false.,error)
     call sic_def_char('map%dec',sic_xymap_user%dec,.false.,error)
     call sic_def_char('map%ra',sic_xymap_user%ra,.false.,error)
     call sic_def_dble('map%angle',sic_xymap_user%pang,0,0,.false.,error)
     call sic_def_logi('map%shift',sic_xymap_user%shift,.false.,error)
     call sic_def_real('map%tole',sic_xymap_user%tole,0,0,.false.,error)
     call sic_def_real('map%reso',sic_xymap_user%reso,1,2,.false.,error)
     call sic_def_real('map%cell',sic_xymap_user%cell,1,2,.false.,error)
     call sic_def_inte('map%size',sic_xymap_user%size,1,2,.false.,error)
     call sic_def_inte('map%wcol',sic_xymap_user%wcol,0,0,.false.,error)
     call sic_def_inte('map%col',sic_xymap_user%col,1,2,.false.,error)
  endif
  !
end subroutine define_sic_xymap
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine init_xymap_struct(xymap)
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  ! MAP Internal routine
  !---------------------------------------------------------------------
  type(xymap_user_t), intent(out) :: xymap  !
  !
  xymap%xcol = 1
  xymap%ycol = 2
  xymap%wcol = 3
  xymap%col(1) = 4
  xymap%col(2) = 0
  xymap%size  = 0.
  xymap%cell  = 0.
  xymap%pang  = 0d0
  xymap%shift = .false.
  xymap%ptype = p_none
  xymap%ra   = ""
  xymap%dec  = ""
  xymap%like = ""
  xymap%wmode = "NATURAL"
  xymap%ctype = ctype_gaussian
  xymap%support = 0.
  xymap%reso = 0.
  xymap%beam = 0.
  xymap%diam = 0.
  xymap%tele = ""
  !
end subroutine init_xymap_struct
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine xymap(line,error)
  use gildas_def
  use gbl_message
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ private
  ! MAP Support routine for command
  !     XY_MAP [TableName]
  ! 1          [/NOGRID]
  ! 2          [/TYPE LMV|VLM|...]
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: line   ! Command line
  logical,          intent(out) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  logical :: nogrid
  integer(kind=4) :: nc
  character(len=4) :: otype
  character(len=filename_length) :: cubename
  !
  ! Ideally 'tablename' should be the only saved parameter.
  ! All other parameters should be deduced from the old cube.
  ! This way, we ensure that the user can achieve the same results
  ! between two consecutive sessions.
  character(len=filename_length), save :: tablename
  !
  ! Parse input line for XY_MAP options
  if (sic_present(0,1)) then  ! Get table name
    nc = 0
    call sic_ch(line,0,1,tablename,nc,.true.,error)
    if (error) return
  else  ! No table name => Current table
    if (tablename.eq.'') then
      call class_message(seve%e,rname,'Empty filename')
      error = .true.
      return
    endif
  endif
  !
  ! Optionally get cube name (blank will reuse table name prefix)
  cubename = ''
  call sic_ch(line,0,2,cubename,nc,.false.,error)
  if (error) return
  !
  ! Parse input line for /NOGRID option
  if (sic_present(1,0)) then
     nogrid = .true.
  else
     nogrid = .false.
  endif
  !
  ! /TYPE
  otype = 'LMV'  ! Default
  call sic_ke(line,2,1,otype,nc,.false.,error)
  if (error) return
  !
  call sub_xymap(tablename,cubename,nogrid,otype,error)
  if (error) return
  !
end subroutine xymap
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine sub_xymap(tablename,cubename,nogrid,lmvcode,error)
  use gbl_message
  use gildas_def
  use image_def
  use classmap_dependencies_interfaces
  use classmap_interfaces, except_this=>sub_xymap
  use xymap_def
  !---------------------------------------------------------------------
  ! @ private
  ! Do the job
  !------------------------------------------------------------------------
  character(len=*), intent(in)  :: tablename  ! Name of input table
  character(len=*), intent(in)  :: cubename   ! Name of output cube
  logical,          intent(in)  :: nogrid     ! Do not convolve, just place
  character(len=*), intent(in)  :: lmvcode    ! LMV or VLM or any...
  logical,          intent(out) :: error      ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  type(xymap_user_t) :: xymap_user  ! Local version of sic_xymap_user
  type(xymap_prog_t) :: map         ! Gridding parameters
  character(len=filename_length) :: prefixname
  !
  ! Timing
  call gag_cputime_init(map%time%total)
  call gag_cputime_init(map%time%read)
  call gag_cputime_init(map%time%sort)
  call gag_cputime_init(map%time%tran)
  call gag_cputime_init(map%time%conv)
  call gag_cputime_init(map%time%writ)
  !
  ! General initialization
  error = .false.
  xymap_user = sic_xymap_user
  !
  call table_open(tablename,prefixname,map%tab,error)
  if (error)  goto 100
  !
  ! Sanity checks
  call check_table_format(xymap_user,map,error)
  if (error)  goto 100
  !
  ! Define gridding parameters (grid + convolution function)
  ! During this step, the table coordinates are rotated and sorted
  ! and the weight array is extracted
  call define_gridding_parameters(xymap_user,map,map%tab%hmem,nogrid,error)
  if (error)  goto 100
  call print_gridding_parameters(map)
  !
  if (cubename.eq.'') then
    call table_to_cube_headers(map,prefixname,lmvcode,error)
  else
    call table_to_cube_headers(map,cubename,lmvcode,error)
  endif
  if (error)  goto 100
  !
  ! Grid data and weights
  call table_to_cube_data(map,nogrid,error)
  if (error)  goto 100
  !
100 continue
  call my_close_image(map%tab%hdisk,error)
  if (error)  continue
  !
  ! Free memory
  if (allocated(map%tab%data))  deallocate(map%tab%data)
  if (allocated(map%tab%buff))  deallocate(map%tab%buff)
  if (allocated(map%tab%x))     deallocate(map%tab%x,map%tab%y,map%tab%w)
  if (allocated(map%tab%sort))  deallocate(map%tab%sort)
  if (allocated(map%cub%data))  deallocate(map%cub%data)
  if (allocated(map%cub%buff))  deallocate(map%cub%buff)
  if (allocated(map%cub%dout))  deallocate(map%cub%dout)
  if (allocated(map%cub%dwei))  deallocate(map%cub%dwei)
  !
  if (error)  return
  !
  ! Success: print timing statistics
  call gag_cputime_get(map%time%total)  ! Get total command time
  call print_cputime_feedback(map%time)
  !
end subroutine sub_xymap
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine table_open(tablename,prefixname,tab,error)
  use image_def
  use gbl_message
  use classmap_dependencies_interfaces
  use classmap_interfaces, except_this=>table_open
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  !  Read the table header
  !---------------------------------------------------------------------
  character(len=*),  intent(in)    :: tablename   ! Table name e.g. 'foo.tab'
  character(len=*),  intent(out)   :: prefixname  ! Prefix shared with the cube e.g. 'foo'
  type(xymap_tab_t), intent(inout) :: tab         !
  logical,           intent(inout) :: error       !
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  integer(kind=4) :: nl
  !
  ! Read table header
  nl = len_trim(tablename)
  if (nl.le.0) then
    call class_message(seve%e,rname,'Empty filename')
    error = .true.
    return
  endif
  !
  call gildas_null(tab%hdisk)
  !
  ! Table name and prefix for the future cube
  if (nl.ge.5 .and. (tablename(nl-3:).eq.'.tab' .or. tablename(nl-3:).eq.'.bat')) then
    ! Explicit extension provided by the user. Still need decoding e.g.
    ! sic logicals
    call sic_parse_file(tablename,'','',tab%hdisk%file)
  else
    ! No extension: first try a .bat table
    call sic_parse_file(tablename,' ','.bat',tab%hdisk%file)
    if (gag_inquire(tab%hdisk%file,len_trim(tab%hdisk%file)).ne.0) then
      ! Else try default .tab
      call sic_parse_file(tablename,' ','.tab',tab%hdisk%file)
    endif
  endif
  ! Check if table exists
  nl = len_trim(tab%hdisk%file)
  if (gag_inquire(tab%hdisk%file,nl).ne.0) then
    call class_message(seve%e,rname,'No such file '//tab%hdisk%file)
    error = .true.
    return
  endif
  prefixname = tab%hdisk%file(1:nl-4)  ! Strip off .bat or .tab
  !
  ! Read disk header
  call gdf_read_header(tab%hdisk,error)
  if (gildas_error(tab%hdisk,rname,error)) return
  tab%velofirst = tab%hdisk%gil%faxi.eq.1
  !
  ! Set up memory header
  call gildas_null(tab%hmem)
  if (tab%velofirst) then
    ! Same header
    call gdf_copy_header(tab%hdisk,tab%hmem,error)
    if (error)  return
  else
    ! Transpose header
    call gdf_transpose_header(tab%hdisk,tab%hmem,'21',error)
    if (error)  return
  endif
  !
end subroutine table_open
!
subroutine table_read_xyw(tab,time,error)
  use gbl_message
  use gkernel_types
  use classmap_dependencies_interfaces
  use classmap_interfaces, except_this=>table_read_xyw
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  !  Fill the X, Y, and weights arrays
  !---------------------------------------------------------------------
  type(xymap_tab_t), intent(inout) :: tab
  type(cputime_t),   intent(inout) :: time
  logical,           intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  character(len=message_length) :: mess
  integer(kind=index_length), parameter :: one=1
  integer(kind=4) :: ier
  real(kind=4), allocatable :: buff(:,:)
  !
  call class_message(seve%i,rname,'Reading columns X Y W')
  !
  call gag_cputime_init(time)
  !
  ! Sanity checks
  if (tab%xcol.ne.1) then
    write(mess,*) 'X column at position ',tab%xcol,' is not implemented'
    call class_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  if (tab%ycol.ne.2) then
    write(mess,*) 'Y column at position ',tab%ycol,' is not implemented'
    call class_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  if (allocated(tab%x))  deallocate(tab%x,tab%y,tab%w)
  allocate(tab%x(tab%nposi),tab%y(tab%nposi),tab%w(tab%nposi),stat=ier)
  if (failed_allocate(rname,'XYW columns',ier,error))  return
  !
  ! For .tab/vxy tables, the X values are not contiguous in memory. Same
  ! for Y and W. In order to avoid traversing the file 3 times, read the
  ! 3 columns at once
  if (tab%wcol.eq.tab%ycol+1) then
    ! X Y W are contiguous
    if (tab%velofirst) then
      allocate(buff(3,tab%nposi),stat=ier)
      call read_vector(tab%xcol,tab%wcol,buff,error)
      if (error)  return
      ! Non contiguous copies, this is done once and then we are done
      tab%x(:) = buff(tab%xcol,:)
      tab%y(:) = buff(tab%ycol,:)
      tab%w(:) = buff(tab%wcol,:)
    else
      allocate(buff(tab%nposi,3),stat=ier)
      call read_vector(tab%xcol,tab%wcol,buff,error)
      if (error)  return
      ! Contiguous copies
      tab%x(:) = buff(:,tab%xcol)
      tab%y(:) = buff(:,tab%ycol)
      tab%w(:) = buff(:,tab%wcol)
    endif
    deallocate(buff)
    !
  else
    ! W is "somewhere else", in the table or no where at all. Split
    ! the job. First X and Y:
    if (tab%velofirst) then
      allocate(buff(2,tab%nposi),stat=ier)
      call read_vector(tab%xcol,tab%ycol,buff,error)
      if (error)  return
      ! Non contiguous copies, this is done once and then we are done
      tab%x(:) = buff(tab%xcol,:)
      tab%y(:) = buff(tab%ycol,:)
    else
      allocate(buff(tab%nposi,2),stat=ier)
      call read_vector(tab%xcol,tab%ycol,buff,error)
      if (error)  return
      ! Contiguous copies
      tab%x(:) = buff(:,tab%xcol)
      tab%y(:) = buff(:,tab%ycol)
    endif
    deallocate(buff)
    ! W?
    if (tab%wcol.ge.1 .or. tab%wcol.le.tab%ndata) then
      call read_vector(tab%wcol,tab%wcol,tab%w,error)
      if (error)  return
    else
      ! Weight column does not exist => Set all weights to 1
      tab%w(:) = 1.0
      write(mess,*) 'Weight column ',tab%wcol,' is outside the column range'
      call class_message(seve%i,rname,mess)
    endif
  endif
  !
  call gag_cputime_get(time)
  !
contains
  subroutine read_vector(first,last,val,error)
    integer(kind=index_length), intent(in)    :: first,last
    real(kind=4),               intent(out)   :: val(*)
    logical,                    intent(inout) :: error
    !
    if (tab%velofirst) then
      tab%hdisk%blc(1:2) = (/ first,      one /)
      tab%hdisk%trc(1:2) = (/  last,tab%nposi /)
    else
      tab%hdisk%blc(1:2) = (/       one,first /)
      tab%hdisk%trc(1:2) = (/ tab%nposi, last /)
    endif
    call gdf_read_data(tab%hdisk,val,error)
    ! if (error)  continue
    ! Reset to avoid later troubles
    tab%hdisk%blc(:) = 0
    tab%hdisk%trc(:) = 0
  end subroutine read_vector
  !
end subroutine table_read_xyw
!
subroutine table_read_data(tab,v1,v2,time,error)
  use gbl_message
  use gkernel_types
  use classmap_dependencies_interfaces
  use classmap_interfaces, except_this=>table_read_data
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  ! Read the data in order VELOCITY - POSITION
  !---------------------------------------------------------------------
  type(xymap_tab_t),          intent(inout) :: tab
  integer(kind=index_length), intent(in)    :: v1,v2  ! [chan] Range to read
  type(xymap_time_t),         intent(inout) :: time   !
  logical,                    intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  integer(kind=index_length) :: iposi,first,last
  integer(kind=index_length), parameter :: one=1
  character(len=message_length) :: mess
  type(cputime_t) :: tmp
  !
  if (v1.lt.1 .or. v2.gt.tab%ndata .or. v1.gt.v2) then
    write(mess,'(2(A,I0))') 'Invalid channel range: ',v1,' to ',v2
    call class_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  tab%nchan = v2-v1+1
  if (tab%wcol.eq.3) then
    first = v1+3
    last = v2+3
  else
    first = v1+2
    last = v2+2
  endif
  !
  call reallocate_tab(tab%data,tab%nchan,tab%nposi,error)
  if (error)  return
  !
  ! Transpose table if needed: the gridding algorithm works in
  ! order [VELOCITY,POSITION]
  if (tab%velofirst) then
    ! Order is correct, read the table as is
    tab%hdisk%blc(1:2) = (/ first,       one /)
    tab%hdisk%trc(1:2) = (/ last,  tab%nposi /)
    call class_message(seve%d,rname,'Reading table...')
    call gag_cputime_init(tmp)
    call gdf_read_data(tab%hdisk,tab%data,error)
    if (gildas_error(tab%hdisk,rname,error))  return
    call gag_cputime_add(time%read,tmp)
    !
  else
    ! Needs transposition. Do it in memory
    tab%hdisk%blc(1:2) = (/       one,first /)
    tab%hdisk%trc(1:2) = (/ tab%nposi, last /)
    ! Read data
    call class_message(seve%d,rname,'Reading table...')
    call gag_cputime_init(tmp)
    call reallocate_tab(tab%buff,tab%nposi,tab%nchan,error)
    if (error)  return
    call gdf_read_data(tab%hdisk,tab%buff,error)
    if (gildas_error(tab%hdisk,rname,error))  return
    call gag_cputime_add(time%read,tmp)
    ! Transpose data. ZZZ check most efficient order
    call class_message(seve%d,rname,'Transposing table...')
    call gag_cputime_init(tmp)
    do iposi=1,tab%nposi
      tab%data(:,iposi) = tab%buff(iposi,:)
    enddo
    call gag_cputime_add(time%tran,tmp)
  endif
  !
end subroutine table_read_data
!
subroutine my_close_image(h,error)
  use image_def
  use classmap_dependencies_interfaces
  !---------------------------------------------------------------------
  ! @ private
  !  GDF-close the input GDF image, if it is opened
  !  Input error status is also preserved on output
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: h
  logical,      intent(inout) :: error
  ! Local
  logical :: error2
  !
  ! Do nothing if image is not yet opened (e.g. on error recovery)
  if (h%loca%islo.eq.0)  return
  !
  error2 = .false.
  call gdf_close_image(h,error2)
  if (gildas_error(h,'XY_MAP',error2))  error = .true.
  !
end subroutine my_close_image
!
subroutine check_table_format(xymap_user,map,error)
  use gbl_message
  use image_def
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  ! MAP internal routine
  !---------------------------------------------------------------------
  type(xymap_user_t), intent(in)    :: xymap_user  ! Input user parameters
  type(xymap_prog_t), intent(inout) :: map         ! Gridding parameters
  logical,            intent(out)   :: error       ! Return status
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  character(len=message_length) :: mess
  integer(kind=4) :: tmp
  !
  ! Initialization
  error = .false.
  !
  ! Table format. Must be velo first / position second in memory.
  if (map%tab%hmem%gil%faxi.eq.1) then
    map%tab%ndata = map%tab%hmem%gil%dim(1)
    map%tab%nposi = map%tab%hmem%gil%dim(2)
  else
    write(mess,'(A,I0)')  'Unexpected frequency axis: ',map%tab%hmem%gil%faxi
    call class_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Column of X coordinates
  if (xymap_user%xcol.ne.0) then
     map%tab%xcol = xymap_user%xcol
  else
     map%tab%xcol = 1
  endif
  if (map%tab%xcol.lt.1 .or. map%tab%xcol.gt.map%tab%ndata) then
     write(mess,*) 'X column #',map%tab%xcol,' does not exist'
     call class_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  !
  ! Column of Y coordinates
  if (xymap_user%ycol.ne.0) then
     map%tab%ycol = xymap_user%ycol
  else
     map%tab%ycol = 2
  endif
  if (map%tab%ycol.lt.1 .or. map%tab%ycol.gt.map%tab%ndata) then
     write(mess,*) 'Y column #',map%tab%ycol,' does not exist'
     call class_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  !
  ! Column of weight
  if (xymap_user%wcol.ne.0) then
     map%tab%wcol = xymap_user%wcol
  else
     map%tab%wcol = 3
  endif
  if (map%tab%wcol.lt.1 .or. map%tab%wcol.gt.map%tab%ndata) then
     write(mess,*) 'Weight column #',map%tab%wcol,' does not exist'
     call class_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  !
  ! First column of data (absolute position in table)
  if (xymap_user%col(1).ne.0) then
     map%col(1) = xymap_user%col(1)
  else
     map%col(1) = 4
  endif
  if (map%col(1).lt.1 .or. map%col(1).gt.map%tab%ndata) then
     write(mess,*) 'Data column #',map%col(1),' does not exist'
     call class_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  !
  ! Last column of data (absolute position in table)
  if (xymap_user%col(2).ne.0) then
     map%col(2) = xymap_user%col(2)
  else
     map%col(2) = map%tab%ndata
  endif
  if (map%col(2).lt.1 .or. map%col(2).gt.map%tab%ndata) then
     write(mess,*) 'Data column #',map%col(2),' does not exist'
     call class_message(seve%e,rname,mess)
     error = .true.
     return
  endif
  !
  ! Protection against wrong ordering
  if (map%col(1).gt.map%col(2)) then
    tmp = map%col(1)
    map%col(1) = map%col(2)
    map%col(2) = tmp
  endif
  !
end subroutine check_table_format
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine reproject_table(tab,system,                        &
                           oldproj,olda0,oldd0,oldangle,      &
                           newproj,newa0,newd0,newangle,error)
  use phys_const
  use gbl_constant
  use gbl_message
  use gkernel_types
  use classmap_dependencies_interfaces
  use classmap_interfaces, except_this=>reproject_table
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  ! Shift-rotate-reproject the table coordinates with a new projection
  ! type and/or new projection center and/or new projection angle.
  !---------------------------------------------------------------------
  type(xymap_tab_t), intent(inout) :: tab          !
  character(len=*),  intent(in)    :: system       ! Coordinate system (for feedback)
  integer(kind=4),   intent(in)    :: oldproj      ! Table projection code
  real(kind=8),      intent(in)    :: olda0,oldd0  ! Table projection center
  real(kind=8),      intent(in)    :: oldangle     ! Table projection angle
  integer(kind=4),   intent(in)    :: newproj      ! Map projection code
  real(kind=8),      intent(in)    :: newa0,newd0  ! Map projection center
  real(kind=8),      intent(in)    :: newangle     ! Map projection angle
  logical,           intent(inout) :: error        ! Returned status
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  character(len=16) :: newa0c,newd0c
  character(len=message_length) :: mess
  type(projection_t) :: oproj,nproj
  integer(kind=4) :: ier
  real(kind=8), allocatable :: xbuf(:),ybuf(:)
  !
  ! ZZZ Ensure early exit if nothing changed! Add some tolerance e.g. on the
  ! center (remember user gives sexag strings and we compare them with r*8)?
  !
  ! We came here because at least one of A0 and/or D0 and/or ANGLE have
  ! changed. Feedback:
  if (system.eq.'EQUATORIAL') then
    call sexag(newa0c,newa0,24)
  else
    call sexag(newa0c,newa0,360)
  endif
  call sexag(newd0c,newd0,360)
  write(mess,'(A,A,1X,A,A,F0.1)')  'Reproject for center ',trim(newa0c),  &
    trim(newd0c),' with angle ',newangle*deg_per_rad
  call class_message(seve%i,rname,mess)
  !
  ! Setup Input projection
  call gwcs_projec(olda0,oldd0,oldangle,oldproj,oproj,error)
  if (error)  return
  !
  ! Setup Output projection
  call gwcs_projec(newa0,newd0,newangle,newproj,nproj,error)
  if (error)  return
  !
  ! Allocate temporary R*8 buffers needed by rel_to_abs and abs_to_rel.
  allocate(xbuf(tab%nposi),ybuf(tab%nposi),stat=ier)
  if (failed_allocate(rname,'coordinate buffers',ier,error))  return
  !
  ! Convert to absolute coordinates. Note that the subroutine allows to
  ! use the same buffers as input and output.
  xbuf(:) = tab%x(1:tab%nposi)
  ybuf(:) = tab%y(1:tab%nposi)
  call rel_to_abs(oproj,xbuf,ybuf,xbuf,ybuf,tab%nposi)
  !
  ! Convert to new projection. Note that the subroutine allows to
  ! use the same buffers as input and output.
  call abs_to_rel(nproj,xbuf,ybuf,xbuf,ybuf,tab%nposi)
  tab%x(1:tab%nposi) = xbuf(:)
  tab%y(1:tab%nposi) = ybuf(:)
  !
  deallocate(xbuf,ybuf)
  !
end subroutine reproject_table
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine define_gridding_parameters(xymap_user,map,hin,nogrid,error)
  use phys_const
  use image_def
  use gbl_message
  use classmap_dependencies_interfaces
  use classmap_interfaces, except_this=>define_gridding_parameters
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  ! MAP internal routine
  ! Compute the map characterictics:
  !  - resolution
  !  - position angle
  !  - pixel size
  !  - gridding function (if not placing)
  !  - map size
  !  - axes
  ! either from (in priority order):
  !  - xymap_user% (i.e. elements of SIC structure map% customized by user)
  !  - xymap_user%like (another map used as reference)
  !  - data positions (if placing is used)
  !  - defaults
  !---------------------------------------------------------------------
  type(xymap_user_t), intent(inout) :: xymap_user  ! Input user parameters
  type(xymap_prog_t), intent(inout) :: map         ! Gridding parameters
  type(gildas),       intent(in)    :: hin         ! Input table header
  logical,            intent(in)    :: nogrid      ! Use placing instead of gridding
  logical,            intent(out)   :: error       ! Return status
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  type(gildas) :: href
  logical :: use_ref,reproject,found,error2,warn
  character(len=filename_length) :: ref_name
  character(len=message_length) :: mess
  real(kind=4) :: xmin,xmax,ymin,ymax,xinc,yinc
  real(kind=4) :: fwhm(2)
  integer(kind=4) :: ndiv
  real(kind=8) :: r8
  !
  ! Initialization
  error = .false.
  use_ref = .false.
  reproject = .false.
  !
  ! Take care of the possibility to choose the grid from a reference file
  if (xymap_user%like.ne.'') then
     ! From reference lmv cube
     use_ref = .true.
     ref_name = xymap_user%like
     call gildas_null(href)
     call sic_parse_file(ref_name,' ','.lmv',href%file)
     call gdf_read_header(href,error)
     if (gildas_error(href,rname,error)) return
     xymap_user%size  = href%gil%dim(1:2)
     xymap_user%cell(1) = href%gil%convert(3,1)*sec_per_rad
     xymap_user%cell(2) = href%gil%convert(3,2)*sec_per_rad
     if (href%char%syst.eq.'EQUATORIAL') then
        ndiv = 24
     else
        ndiv = 360
     endif
     call sexag(xymap_user%ra, href%gil%a0,ndiv)
     call sexag(xymap_user%dec,href%gil%d0,360)
     xymap_user%ptype = href%gil%ptyp
     xymap_user%pang  = href%gil%pang*deg_per_rad
  endif
  !
  ! Telescope beam, sorted by precedence
  if (hin%gil%reso_words.ne.0) then
    ! From table
    map%beam = hin%gil%majo
    map%beam_origin = "table header"
    !
  elseif (xymap_user%tele.ne.'') then
    ! From telescope name (given by user)
    ! Here it should be the sky frequency...
    call my_get_beam(xymap_user%tele,hin%gil%freq,found,map%beam,error)
    if (.not.found) then
      call class_message(seve%e,rname,'Unknown telescope name '//xymap_user%tele)
      error = .true.
      ! Return later
    else
      map%beam_origin = "MAP%TELE"
    endif
    !
  elseif (xymap_user%diam.ne.0.) then
    ! From diameter (given by user)
    map%beam = 1.22d0*(clight_mhz/hin%gil%freq)/xymap_user%diam
    map%beam_origin = "MAP%DIAM"
    !
  elseif (xymap_user%beam.ne.0.) then
    ! Directly given by user
    map%beam = xymap_user%beam*rad_per_sec
    map%beam_origin = "MAP%BEAM"
    !
  elseif (nogrid) then
    ! In /NOGRID mode, the beam is not strictly needed, as we don't need
    ! to compute the resolution and convolution kernel. We need it only for
    ! the matching tolerance (find_xy_increment).
    map%beam = 0.
    map%beam_origin = "NONE"
    !
  else
    call class_message(seve%e,rname,  &
      'The table resolution and the variables MAP%TELE, MAP%DIAM and MAP%BEAM are not defined')
    error = .true.
  endif
  if (error) then
    call class_message(seve%e,rname,  &
      'Impossible to find a correct default for the beam size')
    goto 100
  endif
  !
  ! Map resolution
  warn = .false.
  if (xymap_user%reso(1).ne.0) then
     ! User value
     map%reso(1) = xymap_user%reso(1)*rad_per_sec
     warn = map%reso(1).lt.map%beam  ! Should even warn at map%beam+5.4% for gaussian gridding function
  else
     ! Default: Telescope natural resolution
     map%reso(1) = map%beam
  endif
  if (xymap_user%reso(2).ne.0) then
     ! User value
     map%reso(2) = xymap_user%reso(2)*rad_per_sec
     warn = warn .or. map%reso(2).lt.map%beam
  else
     ! Default: Telescope natural resolution
     map%reso(2) = map%beam
  endif
  if (warn) then
    write(mess,'(5(A,F0.1))')  'Spatial resolution ',map%reso(1)/rad_per_sec,  &
      '" x ',map%reso(2)/rad_per_sec,'" can not be smaller than the beam size (',  &
      map%beam/rad_per_sec,'")'
    call class_message(seve%w,rname,mess)
    ! NB: the resolution will be fixed when computing the gridding function FWHM
  endif
  !
  ! Position tolerance (needed only if /NOGRID)
  if (.not.nogrid) then
    ! Not needed
    map%tole = 0.
  elseif (xymap_user%tole.ne.0.) then
    ! User defined
    map%tole = xymap_user%tole*rad_per_sec
  elseif (map%beam.ne.0.) then
    ! Default: a fraction of the telescope beam
    map%tole = map%beam/10
  else
    call class_message(seve%e,rname,  &
      '/NOGRID needs a tolerance in order to find X and Y increments')
    call class_message(seve%e,rname,  &
      'Set up MAP%TOLE to a fraction of your pixel increments, or')
    call class_message(seve%e,rname,  &
      'set up MAP%TELE, MAP%DIAM or MAP%BEAM and XY_MAP will use a fraction of the beam as tolerance')
    error = .true.
    return
  endif
  !
  ! Type of projection:
  if (use_ref .or. (xymap_user%shift .and. xymap_user%ptype.ne.p_none)) then
    map%ptyp = xymap_user%ptype  ! Can enforce whatever projection kind
    reproject = .true.
  else
    ! Reuse table input type if possible
    if (hin%gil%ptyp.eq.p_radio) then
      ! Force projection to azimuthal because:
      ! 1) radio does not support a rotation angle while azimuthal does,
      ! 2) we export (V\FITS) radio-projected cubes as SFL but with side
      !    effect, it is better to create them non-radio at first place.
      call class_message(seve%w,rname,'Map projection forced to AZIMUTHAL instead of RADIO')
      map%ptyp = p_azimuthal
      reproject = .true.
    else
      map%ptyp = hin%gil%ptyp
    endif
  endif
  ! New projection center (RA):
  !  - if MAP%LIKE is used (MAP%RA always set from reference)
  !  - if MAP%SHIFT is yes and MAP%RA is set
  if (use_ref .or. (xymap_user%shift .and. xymap_user%ra.ne.' ')) then
     call sic_sexa(xymap_user%ra,len(xymap_user%ra),r8,error)
     if (error)  goto 100
     if (hin%char%syst.eq.'EQUATORIAL') then
        map%a0 = r8*pi/12.d0
     else
        map%a0 = r8*pi/180.d0
     endif
     reproject = .true.
  else
     map%a0 = hin%gil%a0
  endif
  ! New projection center (Dec):
  !  - if MAP%LIKE is used (MAP%DEC always set from reference)
  !  - if MAP%SHIFT is yes and MAP%DEC is set
  if (use_ref .or. (xymap_user%shift .and. xymap_user%dec.ne.' ')) then
     call sic_sexa(xymap_user%dec,len(xymap_user%dec),r8,error)
     if (error)  goto 100
     map%d0 = r8*pi/180.d0
     reproject = .true.
  else
     map%d0 = hin%gil%d0
  endif
  ! Grid position angle:
  !  - if MAP%LIKE is used (MAP%ANGLE always set from reference)
  !  - if MAP%SHIFT is yes (no 'null' value available to user)
  if (use_ref .or. xymap_user%shift) then
     map%pang = xymap_user%pang*rad_per_deg
     reproject = .true.
  else
     map%pang = hin%gil%pang
  endif
  !
  call table_read_xyw(map%tab,map%time%xyw,error)
  if (error)  return
  !
  if (reproject) then
    ! Reproject (X,Y) coordinates if needed. This step must be done
    ! before sorting.
    call reproject_table(map%tab,hin%char%syst,                            &
                         hin%gil%ptyp,hin%gil%a0,hin%gil%d0,hin%gil%pang,  &
                         map%ptyp,    map%a0,    map%d0,    map%pang,      &
                         error)
    if (error)  goto 100
  endif
  !
  ! Sort input X Y W buffers, and fill the sorting array
  call sort_xyw(map%tab,error)
  if (error)  goto 100
  !
  ! Compute table x and y range
  ! This step must be done *after* rotation and sorting
  call find_xy_range(map%tab,xmin,xmax,ymin,ymax,error)
  if (error)  goto 100
  !
  ! Compute data smallest increments when needed
  if ((.not.use_ref).and.(nogrid)) then
     xinc = xmax-xmin
     yinc = ymax-ymin
     call find_xy_increment(map%tab,xinc,yinc,map%tole)
  endif
  !
  ! Pixel size
  if (xymap_user%cell(1).ne.0.0) then
     ! User defined
     map%cell(1) = xymap_user%cell(1)*rad_per_sec
  else
     ! Default
     if (nogrid) then
        ! Intrinsic increment
        map%cell(1) = -xinc
     else
        ! Nyquist sampling
        map%cell(1) = -map%reso(1)/2.0
     endif
  endif
  if (xymap_user%cell(2).ne.0.0) then
     ! User defined
     map%cell(2) = xymap_user%cell(2)*rad_per_sec
  else
     ! Default
     if (nogrid) then
        ! Intrinsic increment
        map%cell(2) = yinc
     else
        ! Nyquist sampling
        map%cell(2) = map%reso(2)/2.0
     endif
  endif
  !
  ! Define gridding function.
  if (xymap_user%ctype.eq.ctype_gaussian) then
     !
     ! Gaussian case:
     ! * ctyp = 2, i.e. exponential with parm(3) = 2,
     !   i.e the argument is first squared.
     ! * The FWHM is at least beam/3 resulting in a 5.4% beamsize increase
     ! * At 3 FWHM (support = 3 FWHM), the convolved signal can be
     !   neglected as the Gaussian value is 1.45e-11
     if ((map%reso(1)**2-map%beam**2).gt.(map%beam**2/9.0)) then
        ! User defined: sqrt(reso^2-beam^2)
        fwhm(1) = sqrt(map%reso(1)**2-map%beam**2)
     elseif (nogrid) then
        ! /NOGRID: map%reso(1) already set to map%beam
        fwhm(1) = 0.  ! Unused
     else
        ! Default: beam/3.0
        fwhm(1) = map%beam/3.0
        map%reso(1) = sqrt(map%beam**2+fwhm(1)**2)
     endif
     if ((map%reso(2)**2-map%beam**2).gt.(map%beam**2/9.0)) then
        ! User defined: sqrt(reso^2-beam^2)
        fwhm(2) = sqrt(map%reso(2)**2-map%beam**2)
     elseif (nogrid) then
        ! /NOGRID: map%reso(2) already set to map%beam
        fwhm(2) = 0.  ! Unused
     else
        ! Default: beam/3.0
        fwhm(2) = map%beam/3.0
        map%reso(2) = sqrt(map%beam**2+fwhm(2)**2)
     endif
     if (xymap_user%support(1).ne.0.0) then
        ! User defined
        map%support(1) = xymap_user%support(1)*rad_per_sec
     else
        ! Default
        map%support(1) = 3.0*fwhm(1)
     endif
     if (xymap_user%support(2).ne.0.0) then
        ! User defined
        map%support(2) = xymap_user%support(2)*rad_per_sec
     else
        ! Default
        map%support(2) = 3.0*fwhm(2)
     endif
     map%conv%x%parm(1) = map%support(1)/abs(map%cell(1))
     map%conv%y%parm(1) = map%support(2)/abs(map%cell(2))
     map%conv%x%parm(2) = fwhm(1)/(2*sqrt(log(2.0)))/abs(map%cell(1))
     map%conv%y%parm(2) = fwhm(2)/(2*sqrt(log(2.0)))/abs(map%cell(2))
     map%conv%x%parm(3) = 2
     map%conv%y%parm(3) = 2
     map%conv%x%ctype = ctype_exponential
     map%conv%y%ctype = ctype_exponential
     !
  else if (xymap_user%ctype.gt.7) then
     !
     write(mess,*) "Unknown convolution function: ",xymap_user%ctype
     call class_message(seve%e,rname,mess)
     error = .true.
     !
  else
     !
     write(mess,*) "Convolution function not yet implemented: ",xymap_user%ctype
     call class_message(seve%i,rname,mess)
     error = .true.
     !
  endif
  !
  ! Cube size
  if (xymap_user%size(1).ne.0) then
     ! User defined
     map%cub%nx = xymap_user%size(1)
  elseif (nogrid) then
     ! Use data values pixels, no more since there is no convolution
     map%cub%nx = int((xmax-xmin)/abs(map%cell(1)))+1
  else
     ! Default: X data range + X convolution support size (to ensure that
     !          all the convolution will be available when combining
     !          several cubes gridded at different moments)
     map%cub%nx = nint((xmax-xmin+2*map%support(1))/abs(map%cell(1)))+2
  endif
  if (xymap_user%size(2).ne.0) then
     ! User defined
     map%cub%ny = xymap_user%size(2)
  elseif (nogrid) then
     ! Use data values pixels, no more since there is no convolution
     map%cub%ny = int((ymax-ymin)/abs(map%cell(2)))+1
  else
     ! Default: Y data range + Y convolution support size (to ensure that
     !          all the convolution will be available when combining
     !          several cubes gridded at different moments)
     map%cub%ny = nint((ymax-ymin+2*map%support(2))/abs(map%cell(2)))+2
  endif
  !
  map%cub%nc = map%col(2)-map%col(1)+1
  !
  ! Here the reference pixel and value should take care of xymap_user%ra
  ! and xymap_user%dec ??? JP
  !
  ! Fill conversion formulae
  if (use_ref) then
     ! From reference header
     map%xconv = href%gil%convert(:,1)
     map%yconv = href%gil%convert(:,2)
  elseif (nogrid) then
     ! Center pixels at data places
     map%xconv(3) = map%cell(1)
     if (map%xconv(3).gt.0) then
        map%xconv(1) = 1.0d0 - xmin/map%xconv(3)  ! xmin <=> pixel number 1
     else
        map%xconv(1) = 1.0d0 - xmax/map%xconv(3)
     endif
     map%xconv(2) = 0.0d0
     !
     map%yconv(3) = map%cell(2)
     if (map%yconv(3).gt.0) then
        map%yconv(1) = 1.0d0 - ymin/map%yconv(3)
     else
        map%yconv(1) = 1.0d0 - ymax/map%yconv(3)
     endif
     map%yconv(2) = 0.0d0
  else
     ! From previous parameters
     map%xconv(3) = map%cell(1)
     map%xconv(1) = map%cub%nx/2+1-(xmin+xmax)/2/map%xconv(3)
     map%xconv(2) = 0.0d0
     !
     map%yconv(3) = map%cell(2)
     map%yconv(1) = map%cub%ny/2+1-(ymin+ymax)/2/map%yconv(3)
     map%yconv(2) = 0.0d0
  endif
  map%vconv(1) = hin%gil%convert(1,1)-map%col(1)+1
  map%vconv(2) = hin%gil%voff
  map%vconv(3) = hin%gil%vres
  !
100 continue
  error2 = error
  if (use_ref)  call gdf_close_image(href,error)
  error = error2 .or. error
  !
end subroutine define_gridding_parameters
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine find_xy_range(tab,xmin,xmax,ymin,ymax,error)
  use gbl_message
  use classmap_interfaces, except_this=>find_xy_range
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  !     Search for the limits of the x and y coordinates.
  !     The algorithm assumes that the input table is sorted in increasing
  !     order according to the Y coordinate.
  !---------------------------------------------------------------------
  type(xymap_tab_t), intent(in)    :: tab    !
  real(kind=4),      intent(out)   :: xmin   ! Minimum of X coordinates
  real(kind=4),      intent(out)   :: xmax   ! Maximum of X coordinates
  real(kind=4),      intent(out)   :: ymin   ! Minimum of Y coordinates
  real(kind=4),      intent(out)   :: ymax   ! Maximum of Y coordinates
  logical,           intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  integer(kind=4) :: ilin,valid1
  !
  ! Find first valid data point
  valid1 = 0
  do ilin=1,tab%nposi
    if (tab%w(ilin).ne.0.) then
      valid1 = ilin
      ! As the table is sorted according to y, this is ymin
      ymin = tab%y(valid1)
      ! Initialize search of x minimum and maximum
      xmin = tab%x(valid1)
      xmax = xmin
      exit
    endif
  enddo
  if (valid1.eq.0) then
    call class_message(seve%e,rname,'No valid data points')
    error = .true.
    return
  endif
  !
  ! Search the x minimum and maximum only among valid data points
  do ilin=valid1,tab%nposi
    if (tab%w(ilin).ne.0.) then
      if (tab%x(ilin).lt.xmin) then
        xmin = tab%x(ilin)
      elseif (tab%x(ilin).gt.xmax) then
        xmax = tab%x(ilin)
      endif
    endif
  enddo
  !
  ! Search last valid data point
  do ilin=tab%nposi,valid1,-1
    if (tab%w(ilin).ne.0.) then
      ! As the table is sorted according to y, this is ymax
      ymax = tab%y(ilin)
      exit
    endif
  enddo
  !
end subroutine find_xy_range
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine find_xy_increment(tab,xinc,yinc,tole)
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  ! Find minimum increment in the X and Y coordinates.
  ! If this minimum is lower than the X-Y position tolerance, then send
  ! back this tolerance instead.
  ! Warning: xinc and yinc are assumed to be initialized outside this
  !          subroutine.
  ! *** JP ***
  ! The current algorithm takes forever when the number of table lines
  ! increases. A better way would be to assume that the data coordinates
  ! are indeed already on a grid (this is the use case in which to call
  ! this subroutine!). In this case, finding first the equivalent classes
  ! of the x offsets will be extremely fast because there is not so many
  ! different x offsets! We can then sort them and find the minimum
  ! distance between them. Once this is done, we use exactly the same
  ! algorithm but for the y offsets. To be fully generic, we can use the
  ! same positioning tolerance as used in other parts of this code. Hence,
  ! if the data offsets are not already positioned on a grid, we still
  ! limit the number of equivalence classes and the algorithm should stay fast.
  ! *** JP ***
  !---------------------------------------------------------------------
  type(xymap_tab_t), intent(in)    :: tab   !
  real(kind=4),      intent(inout) :: xinc  ! X minimum increment (initialized to xmax-xmin)
  real(kind=4),      intent(inout) :: yinc  ! Y minimum increment (initialized to ymax-ymin)
  real(kind=4),      intent(in)    :: tole  ! X-Y position tolerance
  ! Local
  integer(kind=4) :: ilin,jlin
  real(kind=4) :: dist
  !
  do ilin = 1,tab%nposi-1
    if (tab%w(ilin).eq.0.)  cycle
    !
    do jlin=ilin+1,tab%nposi
      if (tab%w(jlin).eq.0.)  cycle
      !
      dist = abs(tab%x(jlin)-tab%x(ilin))
      if (dist.gt.tole .and. dist.lt.xinc) xinc = dist
      !
      dist = tab%y(jlin)-tab%y(ilin)
      if (dist.gt.tole .and. dist.lt.yinc) yinc = dist
      !
    enddo
  enddo
end subroutine find_xy_increment
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine print_gridding_parameters(map)
  use gbl_message
  use phys_const
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  ! MAP internal routine
  !---------------------------------------------------------------------
  type(xymap_prog_t), intent(inout) :: map  ! Cube description
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  character(len=message_length) :: mess
  !
  ! User feedback
  write(mess,'(a,i5,f9.1,2es15.3)')  &
    'X axis definition: ',map%cub%nx,map%xconv
  call class_message(seve%r,rname,mess)
  write(mess,'(a,i5,f9.1,2es15.3)')  &
    'Y axis definition: ',map%cub%ny,map%yconv
  call class_message(seve%r,rname,mess)
  write(mess,'(a,i5,f9.1,2es15.3)')  &
    'V axis definition: ',map%cub%nc,map%vconv
  call class_message(seve%r,rname,mess)
  write(mess,'(3(a,i0))')  &
    'Table size: ',map%tab%nposi," positions x ",map%tab%ndata," values"
  call class_message(seve%r,rname,mess)
  write(mess,'(3(a,i0))')  &
    'X, Y and W columns: ',map%tab%xcol,", ",map%tab%ycol," and ",map%tab%wcol
  call class_message(seve%r,rname,mess)
  write(mess,'(2(a,i0))')  &
    'First and last gridded columns: ',map%col(1)," and ",map%col(2)
  call class_message(seve%r,rname,mess)
  write(mess,'(4(a,i0))')  &
    'Cube size: ',map%cub%nx,' by ',map%cub%ny,' pixels x ',map%cub%nc,' channels'
  call class_message(seve%r,rname,mess)
  write(mess,*)  &
    'Grid position angle: ',nint(map%pang*deg_per_rad),' degree'
  call class_message(seve%r,rname,mess)
  write(mess,'(a,f9.1,a,f9.1,a)')  &
    'Field of View: ',0.1*nint(10*map%cub%nx*map%cell(1)*sec_per_rad),'" x ',0.1*nint(10*map%cub%ny*map%cell(2)*sec_per_rad),'"'
  call class_message(seve%i,rname,mess)
  write(mess,'(a,f9.1,a,f9.1,a)')  &
    'Pixel size: ',0.1*nint(10*map%cell(1)*sec_per_rad),'" x ',0.1*nint(10*map%cell(2)*sec_per_rad),'"'
  call class_message(seve%r,rname,mess)
  if (map%reso(1).eq.map%reso(2)) then
     write(mess,'(a,f9.1,a)')  &
       'Spatial resolution: ',0.1*nint(10*map%reso(1)*sec_per_rad),'"'
  else
     write(mess,'(a,f9.1,a,f9.1,a)')  &
       'Spatial resolution: ',0.1*nint(10*map%reso(1)*sec_per_rad),'" x ',0.1*nint(10*map%reso(2)*sec_per_rad),'"'
  endif
  call class_message(seve%r,rname,mess)
  write(mess,'(a,f9.1,3a)')  &
    'Telescope Beam: ',0.1*nint(10*map%beam*sec_per_rad),'" (from ',trim(map%beam_origin),')'
  call class_message(seve%r,rname,mess)
  !
end subroutine print_gridding_parameters
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine table_to_cube_headers(map,basename,lmvcode,error)
  use classmap_dependencies_interfaces
  use classmap_interfaces, except_this=>table_to_cube_headers
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  ! Set up the headers for the output data cube and weight image
  !---------------------------------------------------------------------
  type(xymap_prog_t), intent(inout) :: map
  character(len=*),   intent(in)    :: basename
  character(len=*),   intent(in)    :: lmvcode
  logical,            intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  integer(kind=4) :: ier,iext,pos
  character(len=3) :: trcode  ! Transposition code (e.g. '231' for VLM to LMV)
  character(len=4) :: defext,knownext(2)
  character(len=filename_length) :: prefixname,cubename,weiname
  !
  ! Get transposition code from lmvcode. Input table is ordered VLM=123 in memory
  call transpose_getcode('VLM',lmvcode,trcode,error)
  if (error)  return
  !
  ! File names. Two cases which can be mixed:
  ! 1) the user has provided or not the cube extension (.lmv, .vlm,
  !    .lmv-test, etc)
  ! 2) the basename (without extension) contains or not a dot, e.g.
  !    13co10-10.5asec
  ! Need correct parsing which adds or not an extension.
  !
  ! Decode sic logicals, do not deal for extension for now
  call sic_parse_file(basename,'','',prefixname)
  !
  ! Default extension (depends on lmvcode)
  defext = '.'//lmvcode
  call sic_lower(defext)  ! Default cube extension
  !
  ! Search for known extensions (.lmv, .vlm, .lmv2, .gdf...)
  knownext(1) = defext
  knownext(2) = '.gdf'
  do iext=1,2
    pos = index(prefixname,knownext(iext))
    if (pos.gt.1)  exit
  enddo
  if (pos.gt.1) then
    ! The user has already provided an extension.
    cubename = prefixname
    prefixname(pos:) = ''  ! Strip off .lmv, .vlm, .lmv2, etc
  else
    ! No cube extension yet
    cubename = trim(prefixname)//defext
  endif
  weiname = trim(prefixname)//'.wei'
  !
  ! Cube header
  call table_to_cube_header(cubename,map%tab%hmem,map,trcode,map%cub%hout,error)
  if (error)  return
  map%cub%velofirst = map%cub%hout%gil%faxi.eq.1
  !
  ! Create weight image header as LMV=231 (always)...
  call table_to_cube_header(weiname,map%tab%hmem,map,'231',map%cub%hwei,error)
  if (error)  return
  ! ... and drop the 3rd (V) axis:
  map%cub%hwei%gil%ndim = 2
  map%cub%hwei%gil%dim(3) = 1
  map%cub%hwei%gil%convert(:,3) = 1.d0
  map%cub%hwei%char%code(3) = 'UNKNOWN'
  map%cub%hwei%gil%faxi = 0
  !
  allocate(map%cub%dwei(map%cub%hwei%gil%dim(1),map%cub%hwei%gil%dim(2)),stat=ier)
  if (failed_allocate(rname,"weight image",ier,error))  return
  !
end subroutine table_to_cube_headers
!
subroutine table_to_cube_header(filename,hin,map,trcode,hout,error)
  use image_def
  use gbl_message
  use classmap_dependencies_interfaces
  use classmap_interfaces, except_this=>table_to_cube_header
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  !  Fill the output cube (header part)
  !---------------------------------------------------------------------
  character(len=*),   intent(in)    :: filename  !
  type(gildas),       intent(in)    :: hin       !
  type(xymap_prog_t), intent(in)    :: map       !
  character(len=*),   intent(in)    :: trcode    ! Transposition code e.g. '231'
  type(gildas),       intent(inout) :: hout      !
  logical,            intent(inout) :: error     !
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  type(gildas) :: htmp
  !
  ! Initialize header
  call gildas_null(htmp)
  !
  call gdf_copy_header(hin,htmp,error)
  if (error)  return
  !
  ! Fill data cube header as VLM (natural data ordering)
  htmp%gil%ndim = 3
  htmp%gil%dim(:) = 0
  htmp%gil%dim(1) = map%cub%nc
  htmp%gil%dim(2) = map%cub%nx
  htmp%gil%dim(3) = map%cub%ny
  htmp%gil%convert(:,1) = map%vconv
  htmp%gil%convert(:,2) = map%xconv
  htmp%gil%convert(:,3) = map%yconv
  ! Table has only 2 dimensions, guess the spatial dimensions of the cube.
  ! Code below supports GDFV1 (providing explicitly a 3rd code but unused
  ! now) and GDFV2 tables
  htmp%char%code(1) = hin%char%code(1)
  if (hin%char%code(2)(1:2).eq.'RA') then
    htmp%char%code(2) = 'RA'
    htmp%char%code(3) = 'DEC'
  elseif (hin%char%code(2)(1:3).eq.'LII') then
    htmp%char%code(2) = 'LII'
    htmp%char%code(3) = 'BII'
  else
    call class_message(seve%e,rname,  &
      'Second axis code not recognized: '//hin%char%code(2))
    error = .true.
    return
  endif
  htmp%gil%faxi = 1
  htmp%gil%xaxi = 2
  htmp%gil%yaxi = 3
  htmp%gil%ptyp = map%ptyp
  htmp%gil%a0   = map%a0
  htmp%gil%d0   = map%d0
  htmp%gil%pang = map%pang
  htmp%gil%majo = max(map%reso(1),map%reso(2))
  htmp%gil%mino = min(map%reso(1),map%reso(2))
  htmp%gil%posa = 0.
  htmp%gil%coor_words = 6*gdf_maxdims
  htmp%gil%extr_words = 0
  htmp%gil%uvda_words = 0
  if (htmp%gil%majo.gt.0.) then  ! No need to check htmp%gil%mino
    htmp%gil%reso_words = 3
  else
    ! This can happen in /NOGRID, where the beam is not needed.
    htmp%gil%reso_words = 0
  endif
  !
  ! And now transpose the header
  call gdf_transpose_header(htmp,hout,trcode,error)
  if (error)  return
  !
  ! File name
  hout%file = filename
  call class_message(seve%i,rname,'Creating file: '//hout%file)
  !
end subroutine table_to_cube_header
!
subroutine table_to_cube_data(map,nogrid,error)
  use gbl_message
  use gildas_def
  use gkernel_types
  use classmap_dependencies_interfaces
  use classmap_interfaces, except_this=>table_to_cube_data
  use image_def
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  !  Fill the output cube and weight (data part)
  !---------------------------------------------------------------------
  type(xymap_prog_t), intent(inout) :: map     ! Gridding parameters
  logical,            intent(in)    :: nogrid  ! Do not convolve, just place
  logical,            intent(out)   :: error   ! Return status
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  integer(kind=index_length) :: first_channel,last_channel
  integer(kind=4) :: iblock,mblocks,mc
  real(kind=4) :: bf,mcfloat
  real(kind=4), allocatable :: xcoord(:),ycoord(:)
  integer(kind=4) :: ier,cfcol
  character(len=message_length) :: mess
  type(time_t) :: time
  type(cputime_t) :: tmp
  !
  ! Initialization
  error = .false.
  map%cub%dwei(:,:) = 0.d0
  !
  if (.not.nogrid) then
    ! Pre-compute gridding kernel
    call conv_fn_default(map%conv%x%ctype,map%conv%y%ctype,  &
      map%conv%x%parm,map%conv%y%parm)
    call conv_fn_computation(map%conv%x,error)
    if (error)  return
    call conv_fn_computation(map%conv%y,error)
    if (error)  return
    !
    ! Allocate workspace and x and y gridded coordinates
    allocate(xcoord(map%cub%nx),ycoord(map%cub%ny),stat=ier)
    if (failed_allocate(rname,"xy gridded arrays",ier,error)) return
    ! Compute arrays of x and y gridded coordinates
    call docoor(map%cub%nx,map%xconv(1),map%xconv(2),map%xconv(3),xcoord)
    call docoor(map%cub%ny,map%yconv(1),map%yconv(2),map%yconv(3),ycoord)
  endif
  !
  ! Blocking factor: how many slices do we have to use (at least) to remain
  ! below the Sic logical VOLATILE_MEMORY?
  bf = blocking_factor(map,error)
  if (error)  return
  if (bf.gt.map%cub%nc) then
    ! We need more blocks than channels. This means that if we want to remain
    ! below VOLATILE_MEMORY, we have to process less than 1 channel per
    ! block... We do not round to 1 channel:
    ! - either it is a user mistake, processing channel per channel will be
    !   highly unefficient. User can just fix VOLATILE_MEMORY,
    ! - or this is not a mistake, its data set is huge, and rounding to the
    !   upper value means using more memory than requested while user may
    !   have carefully chosen its VOLATILE_MEMORY.
    ! In any case, stop here
    call class_message(seve%e,rname,  &
      'Less than 1 channel to be processed per block. Increase VOLATILE_MEMORY.')
    error = .true.
    return
  endif
  ! Some considerations about blocking factor: we want an integer number of
  ! blocks and integer number of channels per block and tolerate last block
  ! to be partially used. This may be impossible. Example:
  !  921 channels in total, blocking_factor() proposes to use 38.0 blocks
  !   => 24.23 channels per block
  ! * If we use 24 channels per block, we need 39 blocks
  ! * If we use 25 channels per block, we need 37 blocks...
  ! As the purpose it to remain below a given amount of memory, we prefer
  ! the first solution (do not use one more channel per block), which
  ! means using a more blocks than recommanded in this example.
  mcfloat = map%cub%nc/bf  ! Number of channels per block (float value)
  if (10.*mcfloat.gt.huge(mc)) then
    ! Very small cube and/or huge amount of memory
    mc = huge(mc)/10  ! Just a huge value usable for computations below
  else
    ! Use floor function as argued above
    mc = floor(mcfloat)  ! Number of channels per block (integer)
  endif
  mblocks = map%cub%nc/mc
  if (mc*mblocks.lt.map%cub%nc) mblocks = mblocks+1
  write(mess,'(A,I0,A,I0,A,I0,1X,I0)')  &
    'Mblocks: ',mblocks,', MC: ',mc,', Size: ',mc*mblocks,map%cub%nc
  call class_message(seve%d,rname,mess)
  !
  ! Computing time statistics: counter will be incremented in the convolution
  ! loop, which is itself embedded in the blocks loop. This is not perfect
  ! as there are other operations within a block loop (i.e. the progress in
  ! percentage will be correct but the remaining time projection will not be
  ! correctly estimated), but not that bad as convolution dominates the
  ! processing time.
  call gtime_init(time,mblocks*map%cub%ny,error)
  if (error)  return
  !
  ! Set first channel to read (NB: map%col(1) is absolute position in table)
  if (map%tab%wcol.eq.3) then
    cfcol = 3
  else
    cfcol = 2
  endif
  first_channel = map%col(1)-cfcol
  !
  ! Loop on blocks
  do iblock = 1, mblocks
     call class_message(seve%d,rname,'--------------------')
     last_channel = min(first_channel+mc-1 , map%col(2)-cfcol)
     write(mess,'(5(A,I0))')  'Doing block ',iblock,'/',mblocks,', channels ',  &
       first_channel,':',last_channel,', Nchan = ',last_channel-first_channel+1
     call class_message(seve%d,rname,mess)
     !
     call table_to_cube_datasub(map,iblock.eq.1,first_channel,last_channel,  &
       nogrid,xcoord,ycoord,time,error)
     if (error)  exit
     !
     ! Prepare next subset
     first_channel = last_channel + 1
  enddo
  call class_message(seve%d,rname,'--------------------')
  !
  if (allocated(xcoord))  deallocate(xcoord,ycoord)
  !
  if (allocated(map%cub%dout)) then
    ! The output cube has been saved in memory: now flush to disk
    call class_message(seve%d,rname,'Writing whole cube at once...')
    call gag_cputime_init(tmp)
    ! Open-write-close image at once
    call gdf_write_image(map%cub%hout,map%cub%dout,error)
    if (gildas_error(map%cub%hout,rname,error))  continue
    call gag_cputime_add(map%time%writ,tmp)
  endif
  !
  ! Write gridded weights
  call class_message(seve%d,rname,'Writing weight image...')
  call gdf_write_image(map%cub%hwei,map%cub%dwei,error)
  if (gildas_error(map%cub%hwei,rname,error))  return
  !
contains
  function blocking_factor(map,error)
    use gbl_message
    use classmap_dependencies_interfaces
    use classmap_interfaces
    use xymap_types
    !-------------------------------------------------------------------
    ! Compute blocking factor, using logical name VOLATILE_MEMORY for
    ! the maximum memory available for gridding.
    !-------------------------------------------------------------------
    real(kind=4) :: blocking_factor
    type(xymap_prog_t), intent(in)    :: map
    logical,            intent(inout) :: error
    ! Local
    real(kind=4) :: vmemory
    integer(kind=size_length) :: swords,mwords,twords,cwords
    character(len=message_length) :: mess
    real(kind=4) :: ofact
    !
    twords = map%tab%nposi*map%cub%nc          ! Input table size [words]
    cwords = map%cub%nx*map%cub%ny*map%cub%nc  ! Ouput cube size  [words]
    !
    ! How many memory words are needed for the buffers?
    ! Note that map%cub%nc is used because user may ask for a subset.
    ! TABLE:
    mwords = twords
    if (.not.map%tab%velofirst .or. map%tab%dosort)  &
      mwords = mwords + twords  ! Transposition/sorting buffer
    ! CUBE:
    mwords = mwords + cwords
    if (.not.map%cub%velofirst)  &
      mwords = mwords + cwords  ! Transposition buffer
    ! The other allocatable buffers should be neglictible, and they do not
    ! scale as number of channels
    !
    ier = sic_ramlog('VOLATILE_MEMORY',vmemory)  ! MBytes
    if (ier.ne.0) then
      call class_message(seve%e,rname,'Error decoding logical VOLATILE_MEMORY')
      error = .true.
      return
    endif
    swords = nint(vmemory*1024_8*256_8,kind=size_length)  ! Space words
    write(mess,'(2A)')  'Using at most VOLATILE_MEMORY = ',pretty_size(swords)
    call class_message(seve%d,rname,mess)
    !
    blocking_factor = real(mwords,kind=4)/swords
    !
    if (blocking_factor.le.1.) then
      ! This is the best case where all the problem fits in memory. In
      ! particular, the output cube fits in memory and will be written
      ! at once, whatever its order
      return
    endif
    !
    if (map%cub%velofirst) then  ! VLM
      ! This cube can not be gdf-extended by block, let see if it fits
      ! in memory so that we can write it at once at the very end. Let's
      ! use max 50% for the output cube, the rest for the per-block buffers
      if (cwords.lt.swords/2) then
        call reallocate_cub(map%cub%dout,map%cub%nc,map%cub%nx,map%cub%ny,error)
        if (error)  return
        ! 'cwords' allocate above, independently of the blocking factor
        ! This is as less remaining in VOLATILE_MEMORY:
        swords = swords-cwords
        ! One buffer is already allocated, decrease mwords:
        mwords = mwords-cwords
        ofact = blocking_factor
        blocking_factor = real(mwords,kind=4)/swords
        write(mess,'(4A,F0.2,A,F0.2)')  'Allocated ',trim(pretty_size(cwords)),  &
          ' of memory for the whole VLM cube,',  &
          ' number of blocks changed from ',ofact,' to ',blocking_factor
        call class_message(seve%d,rname,mess)
      else
        write(mess,'(3A)')  'The output VLM cube (',trim(pretty_size(cwords)),  &
          ') does not fit in memory (50% of logical VOLATILE_MEMORY at most)'
        call class_message(seve%e,rname,mess)
        call class_message(seve%e,rname,  &
          'Increase logical VOLATILE_MEMORY or use a LMV cube as output')
        error = .true.
        return
      endif
    else  ! LMV
      ! This cube can be gdf-extended by block, we don't save it in memory
      ! Return without modifying the blocking_factor
    endif
    !
  end function blocking_factor
  !
end subroutine table_to_cube_data
!
subroutine table_to_cube_datasub(map,firstblock,fc,lc,nogrid,xcoord,ycoord,  &
  time,error)
  use gildas_def
  use gbl_message
  use classmap_dependencies_interfaces
  use classmap_interfaces, except_this=>table_to_cube_datasub
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  !  Process 1 block of channels
  !---------------------------------------------------------------------
  type(xymap_prog_t),         intent(inout) :: map             !
  logical,                    intent(in)    :: firstblock      ! First block written?
  integer(kind=index_length), intent(in)    :: fc,lc           ! First and last channels
  logical,                    intent(in)    :: nogrid          !
  real(kind=4)                              :: xcoord(map%cub%nx)  ! Working buffer
  real(kind=4)                              :: ycoord(map%cub%ny)  ! Working buffer
  type(time_t),               intent(inout) :: time            !
  logical,                    intent(inout) :: error           !
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  integer(kind=index_length) :: ix,iy
  type(cputime_t) :: tmp
  !
  call table_read_data(map%tab,fc,lc,map%time,error)
  if (error)  return
  !
  if (map%tab%dosort) then
    call gag_cputime_init(tmp)
    call sort_tab(map%tab%data,map%tab%nchan,map%tab%nposi,map%tab%sort,  &
      map%tab%buff,error)
    if (error)  return
    call gag_cputime_add(map%time%sort,tmp)
  endif
  !
  map%cub%nchan = lc-fc+1
  call reallocate_cub(map%cub%data,map%cub%nchan,map%cub%nx,map%cub%ny,error)
  if (error)  return
  !
  call gag_cputime_init(tmp)
  if (nogrid) then
    call doplace(map,map%tab%data,map%cub%data,map%cub%dwei,time,error)
    if (error)  return
  else
    ! Grid (i.e. convolve using above gridding function)
    call doconv(                          &
          map%tab%nchan,map%tab%nposi,    &  ! Number of input points
          map%tab%data,                   &  ! Input Values
          map%tab%x,map%tab%y,map%tab%w,  &  ! Coordinates and weights
          map%cub%dwei,                   &  ! Gridded weights
          map%cub%nx,map%cub%ny,          &  ! Cube size
          map%cub%data,                   &  ! RAW Cube
          xcoord,ycoord,                  &  ! Cube coordinates
          map%support,map%cell,           &  !
          map%conv,                       &  ! Pre-computed convolution kernel
          time,error)                        ! Timer
    if (error)  return
  endif
  call gag_cputime_add(map%time%conv,tmp)
  !
  ! Blank pixels with zero-valued weights
  do iy=1,map%cub%ny
    do ix=1,map%cub%nx
      if (map%cub%dwei(ix,iy).eq.0.0) then
        map%cub%data(1:map%tab%nchan,ix,iy) = map%cub%hout%gil%bval
      endif
    enddo ! ix
  enddo ! iy
  !
  call cube_write_data(map%cub,firstblock,fc,lc,map%time,error)
  if (error)  continue  ! Need to close image even in case of error
  !
  ! Free the image slot and its lun (else we would accumulate them
  ! e.g. when extending)
  call my_close_image(map%cub%hout,error)
  if (error)  return
  !
end subroutine table_to_cube_datasub
!
subroutine cube_write_data(cub,firstblock,fc,lc,time,error)
  use gbl_message
  use classmap_dependencies_interfaces
  use classmap_interfaces, except_this=>cube_write_data
  use xymap_types
  !---------------------------------------------------------------------
  ! @ private
  !  Write the block of data, either directly on disk, either in memory
  ! depending on the cube order and memory size.
  !---------------------------------------------------------------------
  type(xymap_cub_t),          intent(inout) :: cub         !
  logical,                    intent(in)    :: firstblock  ! First block written?
  integer(kind=index_length), intent(in)    :: fc,lc       ! First and last channels
  type(xymap_time_t),         intent(inout) :: time        !
  logical,                    intent(inout) :: error       !
  ! Local
  character(len=*), parameter :: rname='XY_MAP'
  integer(kind=index_length) :: ix,iy
  integer(kind=index_length), parameter :: one=1
  type(cputime_t) :: tmp
  !
  if (cub%velofirst) then  ! VELO-POSI-POSI
    !
    if (allocated(cub%dout)) then
      call class_message(seve%d,rname,'Writing VLM cube to memory...')
      do iy=1,cub%ny
        do ix=1,cub%nx
          cub%dout(fc:lc,ix,iy) = cub%data(1:cub%nchan,ix,iy)
        enddo
      enddo
      return
      ! Do not cputime this action, this is not "writing data" scope
      !
    elseif (firstblock) then
      ! Image is not yet opened
      call class_message(seve%d,rname,'Writing VLM cube to disk...')
      call gag_cputime_init(tmp)
      cub%hout%gil%dim(1) = cub%nchan
      call gdf_create_image(cub%hout,error)
      if (gildas_error(cub%hout,rname,error))  return
      call gdf_write_data(cub%hout,cub%data,error)
      if (gildas_error(cub%hout,rname,error))  continue
      call gag_cputime_add(time%writ,tmp)
      !
    else
      ! Adding a new block of velocities. Need to extend the cube, but V is
      ! not the last dimension. This is probably possible with gio, but what
      ! about efficiency?
      ! Anyway this should not happen, trapped when computing blocking factor.
      call class_message(seve%e,rname,'Extending a VLM cube is not implemented')
      error = .true.
      return
    endif
    !
  else  ! POSI-POSI-VELO
    call class_message(seve%d,rname,'Transposing to LMV...')
    call gag_cputime_init(tmp)
    call reallocate_cub(cub%buff,cub%nx,cub%ny,cub%nchan,error)
    if (error)  return
    do iy=1,cub%ny
      do ix=1,cub%nx
        cub%buff(ix,iy,1:cub%nchan) = cub%data(1:cub%nchan,ix,iy)
      enddo ! ix
    enddo ! iy
    call gag_cputime_add(time%tran,tmp)
    !
    call gag_cputime_init(tmp)
    if (firstblock) then
      ! Image is not created
      call class_message(seve%d,rname,'Writing LMV cube...')
      cub%hout%gil%dim(3) = cub%nchan
      call gdf_create_image(cub%hout,error)
      if (gildas_error(cub%hout,rname,error))  return
    else
      call class_message(seve%d,rname,'Extending LMV cube...')
      call gdf_extend_image(cub%hout,lc,error)
      if (error)  return
      cub%hout%blc(1:3) = (/ one                ,one                ,fc /)
      cub%hout%trc(1:3) = (/ cub%hout%gil%dim(1),cub%hout%gil%dim(2),lc /)
    endif
    call gdf_write_data(cub%hout,cub%buff,error)
    if (gildas_error(cub%hout,rname,error))  continue
    call gag_cputime_add(time%writ,tmp)
    !
  endif
  !
end subroutine cube_write_data
