subroutine sampler(line,error)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>sampler
  use greg_kernel
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  ! GREG	Support routine for Command
  !	RESAMPLE NX NY/ [/X Xref Xval Xinc] [/Y Yref Yval Yinc]
  !		[/BLANKING Blank]
  ! 	Resample the current Regular Grid onto a different one.
  ! Arguments :
  !	LINE	C*(*)	Command line		Input
  !	ERROR	L	Logical error flag	Output
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  logical :: error                  !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='RESAMPLE'
  real*8 :: xmin,xmax,ymin,ymax,aconv(6),bconv(6)
  real*4 :: blank,ablank(2)
  integer :: nrx,nry,ier
  real(kind=4), pointer :: rgbuf(:,:)
  !
  ! Check arguments
  if (sic_narg(0).ne.2) then
    call greg_message(seve%e,rname,'Two arguments required')
    error = .true.
  endif
  if (rg%status.eq.code_pointer_null) then
    call greg_message(seve%e,rname,'No map loaded')
    error = .true.
  endif
  if (error) return
  !
  ! Blanking value: if /BLANK is not present, use current blanking (even if
  ! no blanking available). Otherwise /BLANK overrides the current blanking val.
  ablank(1)=cblank
  ablank(2)=eblank
  if (sic_present(3,1))then
    blank = cblank
    call sic_r4 (line,3,1,blank,.true.,error)
    if (error) return
    ablank(1)=blank
    ablank(2)=0.0
  endif
  if (sic_present(3,2))then
    blank = eblank
    call sic_r4 (line,3,2,blank,.true.,error)
    if (error) return
    ablank(2)=blank
  endif
  !
  call sic_i4 (line,0,2,nry,.true.,error)
  call sic_i4 (line,0,1,nrx,.true.,error)
  if (error) then
    call greg_message(seve%e,rname,'Specify map dimensions')
    return
  endif
  !
  ! /X option
  if (.not.sic_present(1,0)) then
    xmin = (0.5d0-rg%xref)*rg%xinc+rg%xval
    xmax = (rg%nx+0.5d0-rg%xref)*rg%xinc+rg%xval
    bconv(3) = (xmax-xmin)/dble(nrx)
    bconv(2) = xmin
    bconv(1) = 1.0d0
  else
    call sic_r8 (line,1,3,bconv(3),.true.,error)
    if (error) return
    call sic_r8 (line,1,2,bconv(2),.true.,error)
    if (error) return
    call sic_r8 (line,1,1,bconv(1),.true.,error)
    if (error) return
  endif
  ! /Y option
  if (.not.sic_present(2,0)) then
    ymin = (0.5d0-rg%yref)*rg%yinc+rg%yval
    ymax = (rg%ny+0.5d0-rg%yref)*rg%yinc+rg%yval
    bconv(6) = (ymax-ymin)/dble(nry)
    bconv(5) = ymin
    bconv(4) = 1.0d0
  else
    call sic_r8 (line,2,3,bconv(6),.true.,error)
    if (error) return
    call sic_r8 (line,2,2,bconv(5),.true.,error)
    if (error) return
    call sic_r8 (line,2,1,bconv(4),.true.,error)
    if (error) return
  endif
  !
  ! Now resample
  ! Unfavorable case: RG too small: allocate VM for new RG,resample inside,
  ! deallocate old RG
  aconv(1) = rg%xref
  aconv(2) = rg%xval
  aconv(3) = rg%xinc
  aconv(4) = rg%yref
  aconv(5) = rg%yval
  aconv(6) = rg%yinc
  !
  allocate(rgbuf(nrx,nry),stat=ier)
  error = ier.ne.0
  if (error) goto 30
  !
  call resamp(rg%data,rg%nx,rg%ny,aconv,ablank,rgbuf,nrx,nry,bconv)
  !
  call reassociate_rgdata(rgbuf,nrx,nry,error)
  if (error)  goto 30
  rg%status = code_pointer_allocated  ! Steal rgbuf memory allocation
  !
  rg%xref = bconv(1)
  rg%xval = bconv(2)
  rg%xinc = bconv(3)
  rg%yref = bconv(4)
  rg%yval = bconv(5)
  rg%yinc = bconv(6)
  return
  !
30 call greg_message(seve%e,rname,'Not Enough Virtual Memory available')
  error =.true.
  return
end subroutine sampler
!
subroutine resamp(a,mx,my,aconv,ablank,b,nx,ny,bconv)
  !---------------------------------------------------------------------
  ! @ private
  ! GREG	Stand alone subroutine
  !	Resample an input map to a different grid. bilinear interpolation.
  ! Arguments
  !	A	R*4(*)	Input map of dimensions MX MY
  !	MX,MY	I
  !	ACONV	R*8(6)	Pixel conversion formulae
  !			CONV(1) = Xref, CONV(2)=Xval, CONV(3)=Xinc
  !	B	R*4(*)	Output map of dimensions NX,NY
  !	NX,NY	I
  !	BCONV	R*8(6)
  !	BLANK	R*4	Blanking value
  !---------------------------------------------------------------------
  integer :: mx                     !
  integer :: my                     !
  real*4 :: a(mx,my)                !
  real*8 :: aconv(6)                !
  real*4 :: ablank(2)               !
  integer :: nx                     !
  integer :: ny                     !
  real*4 :: b(nx,ny)                !
  real*8 :: bconv(6)                !
  ! Local
  real*4 :: bval,eval
  !
  integer :: ib,jb,ia,ja
  real*8 :: axref,axval,axinc,ayref,ayval,ayinc
  real*8 :: bxref,bxval,bxinc,byref,byval,byinc
  real*8 :: xa,ya
  real*8 :: xr,yr,dx,dy
  !
  ! Preliminary processing
  bval=ablank(1)
  eval=ablank(2)
  axref = aconv(1)
  axval = aconv(2)
  axinc = aconv(3)
  ayref = aconv(4)
  ayval = aconv(5)
  ayinc = aconv(6)
  bxref = bconv(1)
  bxval = bconv(2)
  bxinc = bconv(3)
  byref = bconv(4)
  byval = bconv(5)
  byinc = bconv(6)
  !
  ! Take Blanking into account, version #1
  if (eval.lt.0) then
    ! No Blanking. Non-existent values are put to BVAL (whatever it is...)
    ! Loop over Output data points
    do jb = 1,ny
      do ib = 1,nx
        !
        ! Find pixel coordinate in input map
        xa = (ib-bxref)*bxinc + bxval
        ya = (jb-byref)*byinc + byval
        xr = (xa-axval)/axinc + axref
        yr = (ya-ayval)/ayinc + ayref
        ia = int (xr)
        ja = int (yr)
        xr = xr-ia
        yr = yr-ja
        dx = 1.d0-xr
        dy = 1.d0-yr
        ! Avoid edges
        if (ia.lt.1 .or. ia.ge.mx .or. ja.lt.1 .or. ja.ge.my) then
          b(ib,jb) = bval
        else
          ! Interpolate (X or Y first, does not matter in this case)
          b(ib,jb) = dx*dy*a(ia,ja)     + xr*dy*a(ia+1,ja) +  &
                     xr*yr*a(ia+1,ja+1) + dx*yr*a(ia,ja+1)
        endif
      enddo
    enddo
  else
    ! Loop over Output data points
    do jb = 1,ny
      do ib = 1,nx
        xa = (ib-bxref)*bxinc + bxval
        ya = (jb-byref)*byinc + byval
        xr = (xa-axval)/axinc + axref
        yr = (ya-ayval)/ayinc + ayref
        ia = int (xr)
        ja = int (yr)
        xr = xr - ia
        yr = yr - ja
        dx = 1.d0-xr
        dy = 1.d0-yr
        if (ia.lt.1 .or. ia.ge.mx .or. ja.lt.1 .or. ja.ge.my) then
          b(ib,jb) = bval
        elseif (abs(a(ia,ja)-bval).le.eval) then
          b(ib,jb) = bval
        elseif (abs(a(ia+1,ja)-bval).le.eval) then
          b(ib,jb) = bval
        elseif (abs(a(ia,ja+1)-bval).le.eval) then
          b(ib,jb) = bval
        elseif (abs(a(ia+1,ja+1)-bval).le.eval) then
          b(ib,jb) = bval
        else
          b(ib,jb) = dx*dy*a(ia,ja)     + xr*dy*a(ia+1,ja)+  &
                     xr*yr*a(ia+1,ja+1) + dx*yr*a(ia,ja+1)
        endif
      enddo
    enddo
  endif
end subroutine resamp
