subroutine map_resample_comm(line,comm,error)
  use gkernel_interfaces
  use mapping_interfaces, except_this=>map_resample_comm
  use clean_def
  use clean_types
  use clean_arrays
  use gbl_message
  use phys_const
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Resample in velocity the Images, or Compress them 
  !   Support for commands
  !     MAP_RESAMPLE WhichOne NC [Ref Val Inc]
  !     MAP_COMPRESS WhichOne NC
  !     MAP_INTEGRATE WhichOne Rmin Rmax RType
  !
  ! WhichOne    Name of map to be processed
  !             Allowed values are DIRTY, CLEAN, SKY
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line  ! Command line
  character(len=*), intent(in) :: comm  ! Calling command
  logical, intent(out) :: error         ! Error flag
  !
  character(len=80) :: chain
  real(8) :: convert(3)
  integer :: nt, nc, nchan
  type (gildas) :: mapout, mapin
  integer :: ier
  logical :: do_sky, do_clean, do_dirty
  character(len=12) :: iname
  ! For RESAMPLE
  integer(kind=index_length) :: ipix1,ipixn
  integer(kind=size_length) :: isize
  integer, allocatable :: ipi(:,:)
  real, allocatable :: ipr (:,:)
  real, allocatable :: din(:,:,:)
  real :: pix1,pixn
  ! For COMPRESS
  integer :: ifi, ic, k, kc
  integer :: istart
  ! For INTEGRATE
  real(4) :: dv=1.0
  real(8) :: drange(2), freq, xposi, yposi
  character(len=12) :: csort
  integer(kind=4), parameter :: msort=3
  character(len=12) :: types(msort),mysort
  integer :: mc(2), naver, isort
  data types /'CHANNEL','VELOCITY','FREQUENCY'/
  !
  error = .false.
  !
  call sic_ke(line,0,1,iname,nc,.true.,error)
  if (error) return
  call gildas_null(mapout, type = 'IMAGE')
  call gildas_null(mapin, type = 'IMAGE')
  !
  isize = 0
  do_clean = .false.
  do_sky   = .false.
  do_dirty = .false.
  !
  select case(iname)
  case('DIRTY')
    isize = hdirty%loca%size
    call gdf_copy_header(hdirty,mapin,error)
    do_dirty = .true.
  case('CLEAN')
    isize = hclean%loca%size
    call gdf_copy_header(hclean,mapin,error)
    do_clean = .true.
  case('SKY')
    isize = hsky%loca%size
    call gdf_copy_header(hsky,mapin,error)
    do_sky = .true.
  case('*') 
    if (hclean%loca%size.ne.0) then
      do_clean = .true.
      isize = hclean%loca%size
      if (hsky%loca%size .ne. 0) then
        if (hsky%loca%size .ne. isize) then
          call map_message(seve%e,comm,'CLEAN and SKY do not match')
          error = .true.
          return
        endif
        do_sky = .true.
      endif
      call gdf_copy_header(hclean,mapin,error)
    else if (hsky%loca%size .ne. 0) then
      isize = hsky%loca%size
      call gdf_copy_header(hsky,mapin,error)
      do_sky = .true.
    endif
  case default
    call map_message(seve%e,comm,'Invalid data name '//trim(iname))
    error = .true.
    return
  end select
  if (isize.eq.0) then
    call map_message(seve%e,comm,'Specified data '//trim(iname)//' is not allocated')
    error = .true.
    return
  endif
  !
  allocate(din(mapin%gil%dim(1),mapin%gil%dim(2),mapin%gil%dim(3)),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,comm,'Memory allocation failure')
    error = .true.
    return  
  endif
  !
  call gdf_copy_header(mapin,mapout,error)
  if (error) return  
  !
  ! FInd out action and parameters
  select case (comm)
  case ('MAP_RESAMPLE')
    call sic_i4(line,0,2,nc,.true.,error)
    if (error) return
    if (nc.gt.mapin%gil%dim(3)) nc = mapin%gil%dim(3)
    ! Set default resampling
    convert = mapin%gil%convert(:,3)
    !
    call sic_r8(line,0,3,convert(1),.false.,error)
    if (error) return
    call sic_r8(line,0,4,convert(2),.false.,error)
    if (error) return
    call sic_r8(line,0,5,convert(3),.false.,error)
    if (error) return
    ! Convert(3) is initially on a Velocity Scale.
    mapout%gil%voff = convert(2)
    mapout%gil%vres = convert(3)
    mapout%gil%fres = - mapout%gil%vres * 1d3 / clight * mapout%gil%freq
    mapout%gil%convert(:,3) = convert
    mapout%gil%dim(3) = nc
    !
    !
    ! Check limits
    pix1 = mapout%gil%ref(3) + ( mapin%gil%val(3) + (1.d0-mapin%gil%ref(3))  &
        & *mapin%gil%inc(3) - mapout%gil%val(3) )/mapout%gil%inc(3)
    pixn = mapout%gil%ref(3) + ( mapin%gil%val(3) + (mapin%gil%dim(3)-mapin%gil%ref(3))  &
        & *mapin%gil%inc(3) - mapout%gil%val(3) )/mapout%gil%inc(3)
    if (pix1.lt.pixn) then
      ipix1 = int(pix1)
      if (ipix1.ne.pix1) ipix1 = ipix1+1
      ipix1 = max(ipix1,1)
      ipixn = min(int(pixn),mapout%gil%dim(3))
    else
      ipixn = min(int(pix1),mapout%gil%dim(3))
      ipix1 = int(pixn)
      if (ipix1.ne.pixn) ipix1 = ipix1+1
      ipix1 = max(ipix1,1)
    endif
    !
    allocate (ipi(2,mapout%gil%dim(3)), ipr(4,mapout%gil%dim(3)), stat=ier)
    !
  case ('MAP_COMPRESS') 
    call sic_i4(line,0,2,nc,.true.,error)
    if (error) return
    if (nc.gt.mapin%gil%dim(3)) nc = mapin%gil%dim(3)
    !
    ! Set offset channel
    istart = 1
    call sic_i4(line,0,3,istart,.false.,error)
    if (error) return
    if (istart.lt.1 .or. istart.gt.nc) then
      Print *,'IStart ',istart,nc
      call map_message(seve%e,comm,'Offset channel out of range')
      error = .true.
      return
    endif
    write(chain,'(A,I6,A)') 'Averaging by chunks of ',nc,' channels'
    call map_message(seve%i,comm,chain)
    !
    mapout%gil%inc(3) = mapin%gil%inc(3)*nc
    mapout%gil%ref(3) = (2.0*mapin%gil%ref(3)+nc-1.0)/2/nc
    mapout%gil%vres = nc*mapin%gil%vres
    mapout%gil%fres = nc*mapin%gil%fres
    ! Change the number of channels
    mapout%gil%dim(3) = (mapin%gil%dim(3)+1-istart)/nc
    if (mapout%gil%dim(3).lt.1) then
      call map_message(seve%e,comm,'Not enough channels')
      error = .true.
      return
    endif
    !
  case ('MAP_INTEGRATE') 
    call sic_r8 (line,0,2,drange(1),.true.,error)
    if (error) return
    call sic_r8 (line,0,3,drange(2),.true.,error)
    if (error) return
    csort = mapin%char%code(3)
    call sic_ke (line,0,4,csort,nc,.false.,error)
    if (error) return
    error = .false.
    call sic_ambigs(comm,csort,mysort,isort,types,msort,error)
    if (error)  return
    !
    ! Define number of channels
    call out_range(comm,csort,drange,mc,mapin,error)
    if (error) return
    ier = gdf_range (mc, mapin%gil%dim(3))
    naver = mc(2)-mc(1)+1
    !
    ! Build a pseudo axis aligned on the input one:
    !  - Number of channels set to 1,
    !  - Increment set to the extracted range,
    !  - Value at reference unchanged (same spectroscopic axis, e.g. regarding
    !    associated Rest Freq),
    !  - Center of averaged range (old axis) is aligned on the center of the
    !    output channel #1 (new axis)
    ! This writes as:
    mapout%gil%ndim = 2
    mapout%gil%dim(3) = 1
    ! mapout%gil%val(3) = unchanged
    yposi = (mc(1)+mc(2))*0.5d0
    xposi = 1.d0
    mapout%gil%inc(3) = mapin%gil%inc(3)*naver
    mapout%gil%ref(3) = xposi - (yposi-mapin%gil%ref(3))/naver
    ! Do not forget the SPECTRO section
    mapout%gil%vres = mapin%gil%vres*naver
    mapout%gil%fres = mapin%gil%fres*naver
    ! mapout%gil%voff = unchanged
    ! mapout%gil%freq = unchanged
    ! mapout%gil%fima = unchanged
    !
    mapout%loca%size = mapout%gil%dim(1)*mapout%gil%dim(2)
    if (mapin%char%code(3).eq.'VELOCITY') then
      mapout%char%unit = trim(mapin%char%unit)//'.km/s'
    elseif (mapin%char%code(3).eq.'FREQUENCY') then
      mapout%char%unit = trim(mapin%char%unit)//'.MHz'
    else
      mapout%char%unit = 'UNKNOWN'
    endif
    mapout%gil%extr_words = 0
    mapout%gil%blan_words = 2
    mapout%gil%bval = 0.
    mapout%gil%eval = 0.    
    dv = abs(mapout%gil%inc(3))
  end select
  !
  ! Now do the job
  if (do_clean) then
    din(:,:,:) = dclean
    deallocate(dclean)
    call sic_delvariable ('CLEAN',.false.,error)
    !
    allocate (dclean(mapout%gil%dim(1),mapout%gil%dim(2),mapout%gil%dim(3)) ,stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,comm,'CLEAN Memory allocation failure')
      error = .true.
      return  
    endif
    if (comm.eq.'MAP_RESAMPLE') then
      call all_inter(mapout%gil%dim(1)*mapout%gil%dim(2),ipix1,ipixn, &
        & dclean,mapout%gil%dim(3),mapout%gil%inc(3),mapout%gil%ref(3),mapout%gil%val(3), &
        & din,mapin%gil%dim(3),mapin%gil%inc(3),mapin%gil%ref(3),mapin%gil%val(3), &
        & ipi, ipr) 
    else if (comm.eq.'MAP_COMPRESS') then
      ifi = istart
      do ic=1,mapout%gil%dim(3)
        do k=ifi,min(ifi+nc-1,mapin%gil%dim(3))
          dclean(:,:,ic) = dclean(:,:,ic) + din(:,:,k)
        enddo
        kc = min(ifi+nc-1,mapin%gil%dim(3))-ifi+1
        dclean(:,:,ic) = dclean(:,:,ic)/kc
        ifi = ifi+nc
      enddo
    else if (comm.eq.'MAP_INTEGRATE') then          
      dclean(:,:,1) = din(:,:,mc(1))
      do ic=mc(1)+1,mc(2)
        dclean(:,:,1) = dclean(:,:,1) + din(:,:,ic)
      enddo
      dclean = dclean*dv
    endif
    call gdf_copy_header(mapout,hclean,error)
    hclean%loca%size = hclean%gil%dim(1)*hclean%gil%dim(2)
    !
    ! Set "new" internal flag 
    save_data(code_save_clean) = .true.
    optimize(code_save_clean)%change = 2  ! Data has been changed, and no Buffer 
    call sic_mapgildas ('CLEAN',hclean,error,dclean)
  endif
  !
  if (do_sky) then
    din(:,:,:) = dsky
    deallocate(dsky)
    call sic_delvariable ('SKY',.false.,error)
    allocate (dsky(mapout%gil%dim(1),mapout%gil%dim(2),mapout%gil%dim(3)) ,stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,comm,'SKY Memory allocation failure')
      error = .true.
      return  
    endif
    if (comm.eq.'MAP_RESAMPLE') then
      call all_inter(mapout%gil%dim(1)*mapout%gil%dim(2),ipix1,ipixn, &
        & dsky,mapout%gil%dim(3),mapout%gil%inc(3),mapout%gil%ref(3),mapout%gil%val(3), &
        & din,mapin%gil%dim(3),mapin%gil%inc(3),mapin%gil%ref(3),mapin%gil%val(3), &
        & ipi, ipr) 
    else if (comm.eq.'MAP_COMPRESS') then
      ifi = istart
      do ic=1,mapout%gil%dim(3)
        do k=ifi,min(ifi+nc-1,mapin%gil%dim(3))
          dsky(:,:,ic) = dsky(:,:,ic) + din(:,:,k)
        enddo
        kc = min(ifi+nc-1,mapin%gil%dim(3))-ifi+1
        dsky(:,:,ic) = dsky(:,:,ic)/kc
        !
        ifi = ifi+nc
      enddo
    else if (comm.eq.'MAP_INTEGRATE') then          
      dsky(:,:,1) = din(:,:,mc(1))
      do ic=mc(1)+1,mc(2)
        dsky(:,:,1) = dsky(:,:,1) + din(:,:,ic)
      enddo
      dsky = dsky*dv
    endif
    call gdf_copy_header(mapout,hsky,error)
    hsky%loca%size = hsky%gil%dim(1)*hsky%gil%dim(2)*hsky%gil%dim(3)
    !
    ! Set "new" internal flag 
    save_data(code_save_sky) = .true.
    optimize(code_save_sky)%change = 2  ! Data has been changed, and no Buffer 
    call sic_mapgildas ('SKY',hsky,error,dsky)
  endif
  !
  if (do_dirty) then
    din(:,:,:) = ddirty
    deallocate(ddirty)
    call sic_delvariable ('DIRTY',.false.,error)
    allocate (ddirty(mapout%gil%dim(1),mapout%gil%dim(2),mapout%gil%dim(3)) ,stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,comm,'DIRTY Memory allocation failure')
      error = .true.
      return  
    endif
    !
    if (comm.eq.'MAP_RESAMPLE') then
      call all_inter(mapout%gil%dim(1)*mapout%gil%dim(2),ipix1,ipixn, &
        & ddirty,mapout%gil%dim(3),mapout%gil%inc(3),mapout%gil%ref(3),mapout%gil%val(3), &
        & din,mapin%gil%dim(3),mapin%gil%inc(3),mapin%gil%ref(3),mapin%gil%val(3), &
        & ipi, ipr) 
    else if (comm.eq.'MAP_COMPRESS') then
      ifi = istart
      do ic=1,mapout%gil%dim(3)
        do k=ifi,min(ifi+nc-1,mapin%gil%dim(3))
          ddirty(:,:,ic) = ddirty(:,:,ic) + din(:,:,k)
        enddo
        kc = min(ifi+nc-1,mapin%gil%dim(3))-ifi+1
        ddirty(:,:,ic) = ddirty(:,:,ic)/kc
        !
        ifi = ifi+nc
      enddo
      ddirty = ddirty/nc
    else if (comm.eq.'MAP_INTEGRATE') then          
      ddirty(:,:,1) = din(:,:,mc(1))
      do ic=mc(1)+1,mc(2)
        ddirty(:,:,1) = ddirty(:,:,1) + din(:,:,ic)
      enddo
      ddirty = ddirty*dv
    endif
    call gdf_copy_header(mapout,hdirty,error)
    hdirty%loca%size = hdirty%gil%dim(1)*hdirty%gil%dim(2)*hdirty%gil%dim(3)
    !
    ! Set "new" internal flag 
    save_data(code_save_dirty) = .true.
    optimize(code_save_dirty)%change = 2  ! Data has been changed, and no Buffer 
    !
    hdirty%gil%reso_words = 3
    hdirty%gil%majo= 0.0
    hdirty%gil%mino= 0.0
    hdirty%gil%posa = 0.0
    call sic_mapgildas('DIRTY',hdirty,error,ddirty)
  endif
  !
  return
contains
!
subroutine all_inter (n,ic1,icn,x,xdim,xinc,xref,xval,y,ydim,yinc,yref,yval,iwork,rwork)
  !---------------------------------------------------------------------
  ! LAS	Internal routine
  !	Performs the linear interpolation/integration
  ! Arguments:
  !	X	R*4(*)	Output spectrum
  !	N	I*4	Map size
  !	XDIM	I*4	Output pixel number
  !	XINC	R*8	Output first axis increment
  !	XREF	R*8	Output first axis reference pixel
  !	XVAL	R*8	Output first axis value at reference pixel
  ! 	Y	R*4(*)	Input spectrum
  !---------------------------------------------------------------------
  integer(kind=index_length) :: n                      !
  integer(kind=index_length) :: ic1                    !
  integer(kind=index_length) :: icn                    !
  integer(kind=index_length) :: xdim                   !
  real :: x(n,xdim)                 !
  real(8) :: xinc                    !
  real(8) :: xref                    !
  real(8) :: xval                    !
  integer(kind=index_length) :: ydim                   !
  real :: y(n,ydim)                 !
  real(8) :: yinc                    !
  real(8) :: yref                    !
  real(8) :: yval                    !
  integer :: iwork(2,xdim)           !
  real :: rwork(4,xdim)              !
  !	iwork = imin,imax
  !	rwork = rmin_1, rmin, rmax, rmax_1
  !
  integer i,imax,imin, j, k
  real(8) minpix, maxpix, pix, val, expand
  real rmin_1, rmin, rmax_1, rmax, smin, smax
  real scale
  !
  ! Special case: output axis = input axis
  if ((xdim.eq.ydim).and.(xref.eq.yref).and.(xval.eq.yval).and.(xinc.eq.yinc)) then
    x = y
    return
  endif
  !
  x = 0
  !
  expand = abs(xinc/yinc)
  scale  = 1.d0/expand
  do i = ic1, icn
    !
    ! Compute interval
    !
    val = xval + (i-xref)*xinc
    pix = (val-yval)/yinc + yref
    maxpix = pix + 0.5d0*expand
    minpix = pix - 0.5d0*expand
    imin = int(minpix+1.0d0)
    imax = int(maxpix)
    iwork(1,i) = imin
    iwork(2,i) = imax
    if (imax.ge.imin) then
      if (imin.gt.1) then
        !
        ! Lower end
        !
        ! YMIN = Y(IMIN-1)*(IMIN-MINPIX)+Y(IMIN)*(MINPIX-IMIN+1)
        !     and
        ! X(I) = X(I) + 0.5 * ( (IMIN-MINPIX)*(YMIN+Y(IMIN)) )
        !   
        ! Coefficient de IMIN-1: RMIN_1 = 0.5 * (IMIN-MINPIX)*(IMIN-MINPIX)
        ! Coefficient de IMIN:   RMIN   = 0.5 * (MINPIX-IMIN+2)*(IMIN-MINPIX)
        !
        smin = imin-minpix
        rwork(1,i) = 0.5*smin*smin
        rwork(2,i) = smin-rwork(1,i)
      else
        ! Coefficient de IMIN:      RMIN   = (IMIN-MINPIX)
        ! Coefficient de IMIN-1:    RMIN_1 = 0
        rwork(1,i) = 0.0
        rwork(2,i) = imin-minpix
      endif
      if (imax.lt.ydim) then
        ! Upper end
        smax = maxpix-imax
        rwork(4,i) = 0.5*smax*smax
        rwork(3,i) = smax-rwork(4,i)
      else
        rwork(3,i) = maxpix-imax
        rwork(4,i) = 0.0
      endif
      if (imax.eq.imin) then
        ! Point Case
        rwork(2,i) = rwork(2,i)+rwork(3,i)
        rwork(3,i) = 0.0
      else
        ! General Case: Add 1/2 of IMIN & IMAX + 1 of all intermediate
        ! channels
        rwork(2,i) = rwork(2,i)+0.5
        rwork(3,i) = rwork(3,i)+0.5
      endif
    else
      if (imin.gt.1) then
        rwork(1,i) = (imin-pix)
        rwork(2,i) = (pix+1-imin)
      else
        rwork(1,i) = 0.0
        rwork(2,i) = 1.0
      endif
    endif
  enddo
  !
  ! OK, now do it...
  do i = ic1, icn
    imin = iwork(1,i)
    imax = iwork(2,i)
    rmin_1 = rwork(1,i)
    rmin   = rwork(2,i)
    rmax   = rwork(3,i)
    rmax_1 = rwork(4,i)
    !
    if (imax.ge.imin) then
      ! General Trapezium integration
      if (imin.gt.1) then
        do j=1,n
          x(j,i) = y(j,imin-1)*rmin_1
        enddo
        do j=1,n
          x(j,i) = x(j,i) + y(j,imin)*rmin
        enddo
      else
        do j=1,n
          x(j,i) = y(j,imin)*rmin
        enddo
      endif
      if (imax.gt.imin) then
        do k = imin+1,imax-1
          do j=1,n
            x(j,i) = x(j,i) + y(j,k)
          enddo
        enddo
        do j=1,n
          x(j,i) = x(j,i) + y(j,imax)*rmax
        enddo
      endif
      if (imax.lt.ydim) then
        do j=1,n
          x(j,i) = x(j,i) + y(j,imax+1)*rmax_1
        enddo
      endif
      ! Normalise
      do j=1,n
        x(j,i) = x(j,i)*scale
      enddo
      !
    else
      ! Interpolation
      if (imin.gt.1) then
        do j=1,n
          x(j,i) = y(j,imin-1)*rmin_1
        enddo
        do j=1,n
          x(j,i) = x(j,i) + y(j,imin)*rmin
        enddo
      else
        do j=1,n
          x(j,i) = y(j,imin)
        enddo
      endif
    endif
  enddo
  !
end subroutine all_inter
!
end subroutine map_resample_comm
