subroutine rgimag(line,optrgdata,dosubset,optsubset,error)
  use gildas_def
  use gbl_format
  use gbl_constant
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>rgimag
  use sic_types
  use greg_image
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for subset of commands
  !   RGDATA  Name
  !     /VARIABLE
  !     [/SUBSET]
  ! and
  !   LIMITS /RGDATA  Name
  ! Load RG data from variable name
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line       ! Command line
  integer(kind=4),  intent(in)    :: optrgdata  ! RG data option
  logical,          intent(in)    :: dosubset   ! Subset option present?
  integer(kind=4),  intent(in)    :: optsubset  ! Subset option number, if relevant
  logical,          intent(inout) :: error      ! Error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='RGDATA'
  character(len=80) :: chain,varia,name
  logical :: header
  real(kind=8) :: conv(6)
  integer(kind=4) :: lc,form,nc
  integer(kind=index_length) :: ix,iy
  type(sic_descriptor_t) :: descr,dconv
  integer(kind=address_length) :: ipd
  integer(kind=4) :: nx1,ny1,nx2,ny2
  !
  save dconv,conv
  !
  call sic_ch (line,optrgdata,1,name,nc,.true.,error)
  if (error) return
  call sic_upper(name)
  !
  ! Option /SUBSET
  if (dosubset) then
    call sic_i4 (line,optsubset,1,nx1,.false.,error)
    if (error) return
    call sic_i4 (line,optsubset,2,ny1,.false.,error)
    if (error) return
    call sic_i4 (line,optsubset,3,nx2,.false.,error)
    if (error) return
    call sic_i4 (line,optsubset,4,ny2,.false.,error)
    if (error) return
    ninfx = min(nx1,nx2)
    ninfy = min(ny1,ny2)
    nsupx = max(nx1,nx2)
    nsupy = max(ny1,ny2)
  endif
  !
  varia = name
  error = .true.
  call sic_materialize(varia,descr,error)
  error = .not.error
  if (error) then
    call greg_message(seve%e,rname,'Variable '//trim(varia)//' not found')
    return
  endif
  !
  ! Try A%DATA if a structure has been specified
  if (descr%dims(1).eq.0 .and. descr%status.lt.0) then
    varia = trim(name)//'%DATA'
    call sic_materialize(varia,descr,error)
    error = .not.error
    if (error) then
      call greg_message(seve%e,rname,'Variable '//trim(varia)//' not found')
      return
    endif
    varia = name
  endif
  !
  ! Support User Coordinates if defined by header
  chain = name
  lc = index(chain,'[')
  if (lc.eq.0) lc = len_trim(chain)+1
  ! Skip the %DATA name if it was specified
  if (lc.ge.6 .and. chain(lc-5:lc-1).eq.'%DATA') then
    lc = lc-5
  endif
  chain(lc:) = '%CONVERT'
  header = .false.
  call sic_descriptor(chain,dconv,header)
  if (header) then
    ipd = gag_pointer(dconv%addr,memory)
    call r8tor8(memory(ipd),conv,6)
  else
    conv(1:6) = 1.d0
  endif
  ix = descr%dims(1)
  iy = descr%dims(2)
  !
  if (dosubset) then
    if (ninfx.lt.1 .or. nsupx.gt.ix .or. ninfy.lt.1 .or. nsupy.gt.iy) then
      call greg_message(seve%e,rname,'Subset is outside variable dimensions')
      call sic_volatile(descr)
      error=.true.
      return
    endif
  endif
  !
  form = descr%type
  if (ix.lt.1) then
    call greg_message(seve%e,rname,'First Dimension is too low')
    error = .true.
  else if (iy.lt.1) then
    call greg_message(seve%e,rname,'Second Dimension is too low')
    error = .true.
    !
  else if (form.eq.fmt_r4) then
    ipd = gag_pointer(descr%addr,memory)
    if (dosubset) then
      call gr4_rgivesub(ix,iy,conv,memory(ipd),ninfx,nsupx,ninfy,nsupy)
    elseif (sic_level(varia).ne.0) then
      call gr4_tgive(ix,iy,conv,memory(ipd))
    else
      call gr4_rgive(ix,iy,conv,memory(ipd))
    endif
    !
  else if (form.eq.fmt_r8) then
    ipd = gag_pointer(descr%addr,memory)
    if (dosubset) then
      call gr8_tgivesub(ix,iy,conv,memory(ipd),ninfx,nsupx,ninfy,nsupy)
    else
      call gr8_tgive(ix,iy,conv,memory(ipd))
    endif
    !
  else if (form.eq.fmt_i4) then
    ipd = gag_pointer(descr%addr,memory)
    if (dosubset) then
      call greg_message(seve%e,rname,'/SUBSET not implemented for I*4 arrays')
      error = .true.
      return
    else
      call gi4_tgive(ix,iy,conv,memory(ipd))
    endif
    !
  else if (form.eq.fmt_i8) then
    ipd = gag_pointer(descr%addr,memory)
    if (dosubset) then
      call greg_message(seve%e,rname,'/SUBSET not implemented for I*8 arrays')
      error = .true.
      return
    else
      call gi8_tgive(ix,iy,conv,memory(ipd))
    endif
    !
  else
    call greg_message(seve%e,rname,'Unsupported format')
    error = .true.
  endif
  if (error) then
    call sic_volatile(descr)
    return
  endif
  !
  ! Put also projection information if needed
  if (header) then
    chain(lc:) = '%PTYPE'
    call sic_get_inte(chain,rg%imag%gil%ptyp,error)
    if (error) then
      !
      ! Do nothing, inherit from current conversion
      error = .false.
    elseif (rg%imag%gil%ptyp.eq.p_none) then
      call greg_projec(p_none,rg%imag%gil%a0)
    else
      !
      ! Define projection characteristics
      chain(lc:) = '%X_AXIS'
      call sic_get_inte(chain,rg%imag%gil%xaxi,error)
      chain(lc:) = '%Y_AXIS'
      call sic_get_inte(chain,rg%imag%gil%yaxi,error)
      if (rg%imag%gil%xaxi.eq.0.and.rg%imag%gil%yaxi.eq.0) then
        rg%imag%gil%xaxi = 1
        rg%imag%gil%yaxi = 2
      endif
      chain(lc:) = '%A0'
      call sic_get_dble(chain,rg%imag%gil%a0,error)
      chain(lc:) = '%D0'
      call sic_get_dble(chain,rg%imag%gil%d0,error)
      chain(lc:) = '%ANGLE'
      call sic_get_dble(chain,rg%imag%gil%pang,error)
      if (rg%imag%gil%xaxi.eq.1.and.rg%imag%gil%yaxi.eq.2) then
        call greg_projec(rg%imag%gil%ptyp,rg%imag%gil%a0)
      elseif (rg%imag%gil%xaxi.eq.2.and.rg%imag%gil%yaxi.eq.1) then
        call greg_projec(rg%imag%gil%ptyp,rg%imag%gil%a0)
      else
        call greg_projec(p_none,rg%imag%gil%a0)
      endif
    endif
    chain(lc:) = '%BLANK[1]'
    call sic_get_real(chain,rg%imag%gil%bval,error)
    chain(lc:) = '%BLANK[2]'
    call sic_get_real(chain,rg%imag%gil%eval,error)
    call gr8_blanking(dble(rg%imag%gil%bval),dble(rg%imag%gil%eval))
    !
    chain(lc:) = '%SYSTEM'
    nc = len(rg%imag%char%syst)
    call sic_get_char(chain,rg%imag%char%syst,nc,error)
    !
    if (error) then
      !
      ! Error = .true. means no system is defined in the variable
      ! Do nothing in such a case: use current system
      error = .false.
    else
      !
      ! Define system if more information is present
      if (rg%imag%char%syst(1:nc).eq.'ICRS') then
        call gr8_system(type_ic,error)
      elseif (rg%imag%char%syst(1:nc).eq.'EQUATORIAL') then
        chain(lc:) = '%EQUINOX'
        call sic_get_real(chain,rg%imag%gil%epoc,error)
        call gr8_system(type_eq,error,rg%imag%gil%epoc)
      elseif (rg%imag%char%syst(1:nc).eq.'GALACTIC') then
        call gr8_system(type_ga,error)
      elseif (rg%imag%char%syst(1:nc).eq.'HORIZONTAL') then
        call gr8_system(type_ho,error)
      else
        call gr8_system(type_un,error)
      endif
      if (error)  return
    endif
  endif                        ! End HEADER
  error = .false.
end subroutine rgimag
!
subroutine rgrsd(line,error)
  use gildas_def
  use gbl_format
  use gbl_message
  use sic_types
  use greg_dependencies_interfaces, no_interface=>gr8_minmax
  use greg_interfaces, except_this=>rgrsd
  use greg_kernel
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  ! Subroutine for Regularly Spaced Data, possibly uncompletely sampled,
  ! in column (XYZ or other variables) "format".
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Command line
  logical,          intent(inout) :: error  !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='RGDATA'
  character(len=message_length) :: string
  integer(kind=size_length) :: ixy,nmin,nmax
  integer :: form,narg,nfx,nfy
  type(sic_descriptor_t) :: xinca,yinca,zinca
  integer(kind=address_length) :: xaddr,yaddr,zaddr
  real(8) :: incx,incy
  real(8) :: xmin,xmax,ymin,ymax
  real(8) :: conv(6)
  real(4) :: blank
  !
  save xinca,yinca,zinca
  !
  ! We need a Blanking value
  if (eblank.ge.0.0d0) then
    blank = cblank
    call sic_r4 (line,5,1,blank,.false.,error)
    if (error) return
  else
    call sic_r4 (line,5,1,blank,.true.,error)
    if (error) then
      call greg_message(seve%e,rname,'Please Set or Specify a blanking value')
      return
    endif
  endif
  ! 3 arguments or None: we have a Regularly Spaced Data either in
  ! [already existing] variables X Y and Z, or in 3 Arrays (in both cases
  ! the /VAR option is superfluous)
  narg=sic_narg(0)
  form = fmt_r8
  !
  call get_incarnation('RGDATA',line,form,ixy,xinca,yinca,error)
  if (error) return
  xaddr = gag_pointer(xinca%addr,memory)
  yaddr = gag_pointer(yinca%addr,memory)
  if (narg.gt.0) then
    call get_same_inca ('RGDATA',line,0,3,form,ixy,zinca,error)
  else
    call get_greg_inca ('RGDATA','Z',form,ixy,zinca,error)
  endif
  if (error) then
    call sic_volatile(xinca)
    call sic_volatile(yinca)
    return
  endif
  zaddr = gag_pointer(zinca%addr,memory)
  !
  if (sic_present(4,0)) then
    call sic_r8 (line,4,1,incx,.false.,error)
    call sic_r8 (line,4,2,incy,.false.,error)
    if (error) then
      call sic_volatile(xinca)
      call sic_volatile(yinca)
      call sic_volatile(zinca)
      return
    endif
    call gr8_minmax(ixy,memory(xaddr),cblank,eblank,xmin,xmax,nmin,nmax)
    call gr8_minmax(ixy,memory(yaddr),cblank,eblank,ymin,ymax,nmin,nmax)
  else
    call find_inc8(memory(xaddr),ixy,xmin,xmax,incx,eblank,cblank)
    call find_inc8(memory(yaddr),ixy,ymin,ymax,incy,eblank,cblank)
  endif
  ! Find Map size
  nfx  = nint((xmax-xmin)/abs(incx))+1
  nfy  = nint((ymax-ymin)/abs(incy))+1
  if (nfx.le.1 .or. nfy.le.1 .or. int(nfx,8)*int(nfy,8).gt.4096*4096) then
    write(string,'(A,I12,A,I12)') 'Unsupported cube dimensions, ',nfx,  &
                                  ' times ',nfy
    call greg_message(seve%e,rname,string)
    call greg_message(seve%e,rname,'Specify more adequate Increments')
    error = .true.
    call sic_volatile(xinca)
    call sic_volatile(yinca)
    call sic_volatile(zinca)
    return
  endif
  ! Axis conversion semigroup
  conv(1)=1.0d0
  conv(2)=xmin
  conv(3)=abs(incx)
  conv(4)=1.0d0
  conv(5)=ymin
  conv(6)=abs(incy)
  ! Get virtual memory if needed. Flush Incarnation before releasing VM,
  ! and call back incarnation After.
  if (rg%status.eq.code_pointer_null       .or.                  &
      rg%status.eq.code_pointer_associated .or.                  &
      (rg%status.eq.code_pointer_allocated .and.                 &
       (ubound(rg%data,1).ne.nfx .or. ubound(rg%data,2).ne.nfy))) then
    ! Reallocation neeeded
    call sic_volatile(xinca)
    call sic_volatile(yinca)
    call sic_volatile(zinca)
    !
    call reallocate_rgdata(nfx,nfy,error)
    if (error)  return
    !
    ! Reallocates VM AFTER the VM for RGDATA
    call get_incarnation('RGDATA',line,form,ixy,xinca,yinca,error)
    if (error) return
    xaddr = gag_pointer(xinca%addr,memory)
    yaddr = gag_pointer(yinca%addr,memory)
    if (narg.gt.0) then
      call get_same_inca ('RGDATA',line,0,3,form,ixy,zinca,error)
    else
      call get_greg_inca ('RGDATA','Z',form,ixy,zinca,error)
    endif
    if (error) then
      call sic_volatile(xinca)
      call sic_volatile(yinca)
      return
    endif
    zaddr = gag_pointer(zinca%addr,memory)
  endif
  !
  ! Computes RGDATA and update several CONPLOT common values
  call rgfromxyz(rg%data,nfx,nfy,memory(xaddr),memory(yaddr),  &
    memory(zaddr),ixy,conv,eblank,cblank,blank,error)
  if (error)  continue  ! Need to clean the temporary variables
  rg%xref = conv(1)
  rg%xval = conv(2)
  rg%xinc = conv(3)
  rg%yref = conv(4)
  rg%yval = conv(5)
  rg%yinc = conv(6)
  ! give back VM
  call sic_volatile(xinca)
  call sic_volatile(yinca)
  call sic_volatile(zinca)
  !
  ! set limit of plot region if requested ???
  !      CALL FLIMIT
end subroutine rgrsd
!
subroutine rgfromxyz(rg,nx,ny,x,y,z,n,conv,eb,cb,b,error)
  use gildas_def
  use gbl_message
  use greg_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Puts Z=F(X,Y) if X and Y are not in a blanked interval;
  !   Z=B where no X,Y
  !---------------------------------------------------------------------
  integer(kind=4),           intent(in)    :: nx         ! X grid size
  integer(kind=4),           intent(in)    :: ny         ! Y grid size
  real(kind=4),              intent(out)   :: rg(nx,ny)  ! Gridded values
  integer(kind=size_length), intent(in)    :: n          ! Number of points
  real(kind=8),              intent(in)    :: x(n)       !
  real(kind=8),              intent(in)    :: y(n)       !
  real(kind=8),              intent(in)    :: z(n)       !
  real(kind=8),              intent(in)    :: conv(6)    ! Conversion formula
  real(kind=8),              intent(in)    :: eb         ! Blanking tolerance
  real(kind=8),              intent(in)    :: cb         ! Blanking
  real(kind=4),              intent(in)    :: b          ! Default value
  logical,                   intent(inout) :: error      !
  ! Local
  character(len=*), parameter :: rname='RGDATA'
  integer(kind=4) :: i,j
  integer(kind=size_length) :: k
  real(kind=8) :: l1,l2
  integer(kind=size_length) :: backp(nx,ny)  ! Automatic array
  character(len=message_length) :: mess
  !
  rg(:,:) = b
  backp(:,:) = 0
  !
  if (eb.lt.0.0d0)then
    do k=1,n
      l1=(x(k)-conv(2))/conv(3) + conv(1)
      i=nint(l1)
      l2=(y(k)-conv(5))/conv(6) + conv(4)
      j=nint(l2)
      if (backp(i,j).gt.0)  goto 10
      rg(i,j)=z(k)
      backp(i,j) = k
    enddo
  else
    do k=1,n
      if (abs(x(k)-cb).gt.eb.or.abs(y(k)-cb).gt.eb) then
        l1=(x(k)-conv(2))/conv(3) + conv(1)
        i=nint(l1)
        l2=(y(k)-conv(5))/conv(6) + conv(4)
        j=nint(l2)
        if (backp(i,j).gt.0)  goto 10
        rg(i,j)=z(k)
        backp(i,j) = k
      endif
    enddo
  endif
  return
  !
  ! Error
10 continue
  write(mess,'(5(A,I0))')  'Pixel at position (',i,',',j,  &
    ') is defined several times at indices ',backp(i,j),' and ',k
  call greg_message(seve%e,rname,mess)
  error = .true.
  return
  !
end subroutine rgfromxyz
!
subroutine greg_rgdata(line,error)
  use gildas_def
  use gbl_constant
  use gbl_format
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>greg_rgdata
  use greg_image
  use greg_kernel
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !  RGDATA Name
  !   [/SUBSET Imin Jmin Imax Jmax]
  !   [/VARIABLE]
  !   [/FORMAT fmt_code]
  !  Read a RGDATA file into the Regular grid array
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   !
  logical,          intent(inout) :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='RGDATA'
  integer(kind=4) :: nx1,ny1,nx2,ny2,nfx,nfy,lc
  logical :: all,noproblem,dosubset
  character(len=40), save :: fmt
  character(len=80) :: chain,string
  character(len=filename_length) :: namfile
  integer(kind=4) :: nc,ier,code,narg
  integer(kind=4), parameter :: optsubs=1
  integer(kind=4), parameter :: optvari=2
  integer(kind=4), parameter :: optform=3
  integer(kind=4), parameter :: optincr=4
  integer(kind=4), parameter :: optblan=5
  ! Data
  data fmt /' '/
  !
  narg = sic_narg(0)
  if (narg.eq.3 .or. narg.eq.0) then
    ! 3 arguments or None: we have a Regularly Spaced Data either in [already
    ! existing] variables X Y and Z, or in 3 Arrays
    if (sic_present(optvari,0)) then
      if (narg.eq.0) then
        call greg_message(seve%e,rname,  &
          'Invalid option /VARIABLE when no argument is passed to command')
      else
        call greg_message(seve%e,rname,  &
          'Option /VARIABLE conflicts with the 3 X Y Z arrays passed to command')
      endif
      error = .true.
      return
    endif
    call rgrsd(line,error)
    return
  elseif (narg.eq.1) then
    call sic_ch(line,0,1,chain,nc,.true.,error)
    if (error) return
  else
    call greg_message(seve%e,rname,'Zero, One or Three arguments please')
    error = .true.
    return
  endif
  !
  ! /VARIABLE option
  if (sic_present(optvari,0)) then
    ! Variable name is taken from argument to command i.e. RGDATA Name /VARIABLE
    dosubset = sic_present(optsubs,0)
    if (dosubset .and. .not.sic_present(optsubs,4)) then
      call greg_message(seve%e,rname,'Map subset must be defined by 4 integers')
      error = .true.
      return
    endif
    ! Now read the variable
    call rgimag(line,0,dosubset,optsubs,error)
    return
  endif
  !
  ! Find the file name and open the file
  code=fmt_r4
  call sic_parsef (chain,namfile,' ','.dat')
  ier = sic_open(jtmp,namfile,'OLD',.true.)
  if (ier.ne.0) then
    string = 'Cannot open file '//namfile
    call greg_message(seve%e,rname,string)
    call putios('E-RGDATA,  ',ier)
    error = .true.
    return
  endif
  !
  ! Read header
  call rghead(error)
  if (error) goto 30
  !
  all = .not.sic_present(optsubs,0)
  noproblem = .not.sic_present(optform,0)
  ! Option /SUBSET
  if (all) then
    nfx = fnx
    nfy = fny
    ninfx = 1
    ninfy = 1
    nsupx = nfx
    nsupy = nfy
    if (nfx*nfy.gt.512*512)  &
      call greg_message(seve%w,rname,'Map is very large, contouring '//  &
      'may be slow')
  else
    if (.not.sic_present(optsubs,4)) then
      call greg_message(seve%e,rname,'Map subset must be defined by 4 integers')
      error = .true.
      goto 30
    endif
    call sic_i4 (line,optsubs,1,nx1,.false.,error)
    if (error) goto 30
    call sic_i4 (line,optsubs,2,ny1,.false.,error)
    if (error) goto 30
    call sic_i4 (line,optsubs,3,nx2,.false.,error)
    if (error) goto 30
    call sic_i4 (line,optsubs,4,ny2,.false.,error)
    if (error) goto 30
    ninfx = min(nx1,nx2)
    ninfy = min(ny1,ny2)
    nsupx = max(nx1,nx2)
    nsupy = max(ny1,ny2)
    if (ninfx.lt.1 .or. nsupx.gt.fnx .or. ninfy.lt.1 .or. nsupy.gt.fny) then
      call greg_message(seve%e,rname,'Map subset does not lie in the map')
      error = .true.
      goto 30
    endif
    nfx = nsupx-ninfx+1
    nfy = nsupy-ninfy+1
  endif
  !
  ! /FORMAT option
  if (sic_present(optform,0)) then
    call sic_ch (line,optform,1,chain,lc,.true.,error)
    if (error) goto 30
    if (lc.gt.len(fmt)-2) then
      call greg_message(seve%e,rname,'Format is too long')
      error = .true.
      goto 30
    endif
    fmt = '('//chain(1:lc)//')'
    noproblem=.true.
    if (sic_present(optform,2)) then
      call sic_ke (line,optform,2,chain,nc,.true.,error)
      if (error) goto 30
      noproblem=.false.
      if (chain(1:2).eq.'R4') then
        code=fmt_r4
        noproblem=.true.
      elseif (chain(1:2).eq.'R8') then
        code=fmt_r8
      elseif (chain(1:2).eq.'I4') then
        code=fmt_i4
      elseif (chain(1:2).eq.'I2') then
        code=fmt_i2
      elseif (chain(1:2).eq.'BY') then
        code=fmt_by
      else
        call greg_message(seve%e,rname,'Unsupported data type'//chain(1:2))
        error = .true.
        goto 30
      endif
    endif
  endif
  !
  ! Get virtual memory if needed
  call reallocate_rgdata(nfx,nfy,error)
  if (error)  goto 30
  !
  ! Load it
  if (noproblem) then
    call rgread(rg%data,all,nfx,nfy,fmt,error)
  else
    call rgread_all(rg%data,nfx,nfy,fmt,code,error)
  endif
  if (error) goto 30
  !
  ! Set limits of Plot region if requested
  call flimit
30 close (unit=jtmp)
  !
end subroutine greg_rgdata
!
subroutine rghead (error)
  use greg_interfaces, except_this=>rghead
  use greg_kernel
  use greg_image
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! GREG	Internal routine
  !	This subroutine reads a map header and retrieves the following
  ! 	information for later use by GREG
  !		XREF, NX, XVAL, XINC, XUNIT
  !		YREF, NY, YVAL, YINC, YUNIT
  ! Arguments :
  !	NX	I	Number of X pixels		Output
  !	NY	I	Number of Y pixels		Output
  !	*	*	Alternate error return		Input
  ! No subroutine referenced
  ! Commons	GRUNIT, FITS
  !---------------------------------------------------------------------
  logical :: error                  !
  ! Local
  character(len=*), parameter :: rname='RGDATA'
  character(len=80) :: xtype,ytype,chain
  !
  read(jtmp,*,err=100) fnx,fxref,fxval,fxinc
  read(jtmp,'(A)') xtype
  read(jtmp,*,err=100) fny,fyref,fyval,fyinc
  read(jtmp,'(A)') ytype
  xunit='UNKNOWN'
  yunit='UNKNOWN'
  !
  chain = 'X axis comment: '//xtype
  call greg_message(seve%i,rname,chain)
  chain = 'Y axis comment: '//ytype
  call greg_message(seve%i,rname,chain)
  call greg_message(seve%i,rname,'File header read successfully')
  return
  !
100 call greg_message(seve%e,rname,'Input conversion error in header')
  error = .true.
end subroutine rghead
!
subroutine rgread(regmap,all,nfx,nfy,fmt,error)
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>rgread
  use greg_kernel
  use greg_image
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  ! GREG 	Internal routine
  !	  Read the data in a RGDATA file
  !   An optional format can be specified. Default is 10Z8.8
  !---------------------------------------------------------------------
  integer, intent(in) :: nfx                    ! X grid size
  integer, intent(in) :: nfy                    ! Y grid size
  real(4), intent(out):: regmap(nfx*nfy)        ! Grid values
  logical, intent(in) :: all                    ! Read all map ?
  character(len=*), intent(in) :: fmt           ! Format for reading
  logical, intent(out) :: error                 !
  ! Local
  character(len=*), parameter :: rname='RGDATA'
  real(4) :: zbuf(20)
  integer(4) :: ibuf(20)
  integer(4) :: ndata,nout,k,l,n,i,i1,j1,ier
  character(len=80) :: chain
  equivalence (ibuf,zbuf)
  !
  ! From the header, we have FNX*FNY integer pixel values to read
  ! in format FMT or 10Z8.8. Unpack the data in unit of 80 bytes.
  !
  ndata=fnx*fny
  nout =nfx*nfy
  k = 0
  !
  ! Start of data conversion loop.
  if (all) then
    !
    ! Quick retrieval of complete Map
    if (fmt.eq.' ') then
      call rgsread(jtmp,regmap,fmt,nout,ier)
    elseif (index(fmt,'Z').ne.0) then
      call rgsread(jtmp,regmap,fmt,nout,ier)
    else
      read(jtmp,fmt,iostat=ier) regmap
    endif
    if (ier.ne.0) then
      call putios('E-RGDATA,  ',ier)
      error = .true.
      return
    endif
    rg%xref = fxref
    rg%yref = fyref
    !
    ! Retrieve only a Subset of the map. For optimisation reasons,
    ! the test for a run time format is done outside the main loop.
    !
    ! This part of the code will usually complain if the file is
    ! not appropriately padded.
  else
    !
    ! Default 10Z8.8 format
    if (fmt.eq.' ') then
      l=0
      i1=0
      j1=1
      !
20    read(jtmp,'(10Z8.8)',iostat=ier)  ibuf
      n = 80
      if (ier.ne.0) then
        call putios('E-RGDATA,  ',ier)
        error = .true.
        return
      endif
      n=n/4
      n=min(ndata-l,n)
      !
      ! Fill the array
      do i=1,n
        l=l+1
        i1=i1+1
        if (i1.gt.fnx) then
          i1=1
          j1=j1+1
        endif
        if (j1.lt.ninfy) cycle ! I
        if (j1.gt.nsupy) cycle ! I
        if (i1.lt.ninfx) cycle ! I
        if (i1.gt.nsupx) cycle ! I
        k = k+1
        regmap(k) = zbuf(i)
      enddo
      if (l.lt.ndata .and. k.lt.nout) goto 20
      ! Run time format
    else
      l=0
      i1=0
      j1=1
      ! Will crash at end of file, unless the last line has been padded....
40    continue
      if (index(fmt,'Z').eq.0) then
        read(jtmp,fmt,iostat=ier) zbuf
      else
        read(jtmp,fmt,iostat=ier) ibuf
      endif
      if (ier.ne.0) then
        call putios('E-RGDATA,  ',ier)
        error = .true.
        return
      endif
      n = 20
      n = min(ndata-l,n)
      !
      ! Fill the array
      do i=1,n
        l=l+1
        i1=i1+1
        if (i1.gt.fnx) then
          i1=1
          j1=j1+1
        endif
        if (j1.lt.ninfy) cycle ! I
        if (j1.gt.nsupy) cycle ! I
        if (i1.lt.ninfx) cycle ! I
        if (i1.gt.nsupx) cycle ! I
        k = k+1
        regmap(k) = zbuf(i)
      enddo
      if (l.lt.ndata .and. k.lt.nout) goto 40
    endif
    !
    ! Update reference pixel
    rg%xref = fxref + 1. - ninfx
    rg%yref = fyref + 1. - ninfy
  endif
  !
  ! Other initialisations
  rg%nx = nfx
  rg%ny = nfy
  rg%xval = fxval
  rg%yval = fyval
  rg%xinc = fxinc
  rg%yinc = fyinc
  call greg_message(seve%i,rname,'Data read successfully')
  write(chain,1004) rg%nx,rg%ny
  call greg_message(seve%i,rname,chain)
  write(chain,1003)
  call greg_message(seve%i,rname,chain)
  write(chain,1002) 'X',rg%xref,rg%xval,rg%xinc
  call greg_message(seve%i,rname,chain)
  write(chain,1002) 'Y',rg%yref,rg%yval,rg%yinc
  call greg_message(seve%i,rname,chain)
  error = .false.
  return
  !
1002 format(t5,a,t12,1pg11.4,t30,1pg13.6,t50,1pg11.4)
1004 format('Map size is ',i3,' by ',i3)
1003 format('   Axis',t12,'Reference pixel',t33,'Value',t50,'Increment')
end subroutine rgread
!
subroutine rgread_all(regmap,nfx,nfy,fmt,code,error)
  use gbl_format
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>rgread_all
  use greg_kernel
  use greg_image
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  ! GREG 	Internal routine
  !	Read the data in a RGDATA file
  ! Arguments :
  !     REGMAP	R*4 (*)	Regular grid array to be filled		Output
  !     NFX	I*4	First map dimension			Output
  !     NFY	I*4	Second map dimension			Output
  !     FMT	C*(*)	Data file format			Input
  !     CODE      I*4     Input data type                         Input
  !     ERROR	L	Error return			        Output
  !---------------------------------------------------------------------
  integer, intent(in) :: nfx                    ! X grid size
  integer, intent(in) :: nfy                    ! Y grid size
  real(4), intent(out):: regmap(nfx*nfy)        ! Grid values
  character(len=*), intent(in) :: fmt           ! Format for reading
  integer, intent(in) :: code                   ! Type of data
  logical, intent(out) :: error                 !
  !    
  ! Local
  character(len=*), parameter :: rname='RGDATA'
  integer :: atom,kk,ier
  integer(4) :: ndata,k,l,n,i,i1,j1
  character(len=256) :: longue
  integer(kind=1) :: bbuf(256)
  integer(2):: i2buf(128)
  integer(4) :: i4buf(64)
  real(4) :: r4buf(64)
  real(8) :: r8buf(32)
  equivalence(bbuf,i2buf)
  equivalence(bbuf,i4buf)
  equivalence(bbuf,r4buf)
  equivalence(bbuf,r8buf)
  character(len=80) :: chain
  !
  ndata=fnx*fny
  k = 0
  if (code.eq.fmt_r8) then
    atom = 16
  elseif (code.eq.fmt_r4) then
    atom = 8
  elseif (code.eq.fmt_i4) then
    atom = 8
  elseif (code.eq.fmt_i2) then
    atom = 4
  elseif (code.eq.fmt_by) then
    atom = 2
  endif
  if (index(fmt,'A').ne.0) atom=atom/2
  !
  ! Start of data conversion loop.
  rg%xref = fxref
  rg%yref = fyref
  l=0
  i1=0
  j1=1
  !
40 read(jtmp,'(A)',iostat=ier) longue
  if (ier.ne.0) then
    call putios('E-RGDATA,  ',ier)
    error = .true.
    return
  endif
  n = len_trim(longue)
  if (n.eq.0) goto 40
  n = n/atom
  n = min(ndata-l,n)
  !
  ! Read
  if (code.eq.fmt_r8) then
    read(longue,fmt,iostat=ier) (r8buf(kk),kk=1,n)
  elseif (code.eq.fmt_r4) then
    read(longue,fmt,iostat=ier) (r4buf(kk),kk=1,n)
  elseif (code.eq.fmt_i4) then
    read(longue,fmt,iostat=ier) (i4buf(kk),kk=1,n)
  elseif (code.eq.fmt_i2) then
    read(longue,fmt,iostat=ier) (i2buf(kk),kk=1,n)
  elseif (code.eq.fmt_by) then
    read(longue,fmt,iostat=ier) (bbuf(kk),kk=1,n)
  endif
  if (ier.ne.0) then
    call putios('E-RGDATA,  ',ier)
    error = .true.
    return
  endif
  !
  ! Fill the array
  do i=1,n
    l  = l+1
    i1 = i1+1
    if (i1.gt.fnx) then
      i1=1
      j1=j1+1
    endif
    if (j1.lt.ninfy) cycle     ! I
    if (j1.gt.nsupy) cycle     ! I
    if (i1.lt.ninfx) cycle     ! I
    if (i1.gt.nsupx) cycle     ! I
    k = k+1
    if (code.eq.fmt_r8) then
      regmap(k) = r8buf(i)
    elseif (code.eq.fmt_r4) then
      regmap(k) = r4buf(i)
    elseif (code.eq.fmt_i4) then
      regmap(k) = i4buf(i)
    elseif (code.eq.fmt_i2) then
      regmap(k) = i2buf(i)
    elseif (code.eq.fmt_by) then
      regmap(k) = bbuf(i)
    endif
  enddo
  if (l.lt.ndata) goto 40
  !
  ! Bytes have to be unsigned
  if (code.eq.fmt_by) then
    do k=1,nfx*nfy
      if (regmap(k).lt.0) regmap(k)=regmap(k)+256
    enddo
  endif
  !
  ! Update reference pixel
  rg%xref = fxref + 1. - ninfx
  rg%yref = fyref + 1. - ninfy
  !
  ! Other initialisations
  rg%nx = nfx
  rg%ny = nfy
  rg%xval = fxval
  rg%yval = fyval
  rg%xinc = fxinc
  rg%yinc = fyinc
  call greg_message(seve%i,rname,'Data read successfully')
  write(chain,1004) rg%nx,rg%ny
  call greg_message(seve%i,rname,chain)
  write(chain,1003)
  call greg_message(seve%i,rname,chain)
  write(chain,1002) 'X',rg%xref,rg%xval,rg%xinc
  call greg_message(seve%i,rname,chain)
  write(chain,1002) 'Y',rg%yref,rg%yval,rg%yinc
  call greg_message(seve%i,rname,chain)
  return
  !
1002 format(t5,a,t12,1pg11.4,t30,1pg13.6,t50,1pg11.4)
1004 format('Map size is ',i3,' by ',i3)
1003 format('   Axis',t12,'Reference pixel',t33,'Value',t50,'Increment')
end subroutine rgread_all
!
subroutine rgsread(jtmp,r,fmt,n,ier)
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !---------------------------------------------------------------------
  integer :: jtmp                   !
  integer :: n                      !
  integer :: r(n)                   !
  character(len=*) :: fmt           !
  integer :: ier                    !
  !
  if (fmt.eq.' ') then
    read(jtmp,'(10Z8.8)',iostat=ier) r
  else
    read(jtmp,fmt,iostat=ier) r
  endif
end subroutine rgsread
!
subroutine find_inc8 (input,ixy,xmin,xmax,xinc,eblank,cblank)
  use gildas_def
  use greg_dependencies_interfaces
  use greg_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! Find the increment from X,Y values which are regularly sampled
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in) :: ixy  ! Number of values
  real(8), intent(in) :: input(ixy)             ! Values
  real(8), intent(out) :: xmin                  ! Minimum
  real(8), intent(out)  :: xmax                 ! Maximum
  real(8), intent(out)  :: xinc                 ! Step
  real(8), intent(in) :: eblank                 ! Blanking tolerance
  real(8), intent(in) :: cblank                 ! Blanking
  ! Local
  real(8), allocatable :: value(:) 
  integer(kind=size_length) :: nval,i,j,nmin,nmax
  integer :: ier
  real(8) :: l1,l2
  logical :: found
  !
  nval = 1
  allocate (value(ixy), stat=ier)
  value(1) = input(1)
  !
  do i=2,ixy
    found = .false.
    do j=1,nval
      if (input(i).eq.value(j)) then
        found = .true.
        exit
      endif
    enddo
    if (.not.found) then
      nval  = nval+1
      value(nval) = input(i)
    endif
  enddo
  !
  call gr8_minmax(nval,value,cblank,eblank,xmin,xmax,nmin,nmax)
  !
  xinc = xmax-xmin
  if (eblank.lt.0.0d0) then
    do i=1,nval-1
      l1=value(i)
      do j=i+1,nval
        l2 = value(j)
        xinc = min(xinc,abs(l1-l2))
      enddo
    enddo
  else
    do i=1,nval-1
      l1=value(i)
      if (abs(l1-cblank).gt.eblank) then
        do j=i+1,nval
          l2 = value(j)
          if (abs(l2-cblank).gt.eblank) then
            xinc = min(xinc,abs(l1-l2))
          endif
        enddo
      endif
    enddo
  endif
  deallocate (value)
end subroutine find_inc8
!
! Obsolete Routines
!
subroutine find_mapchar8(x,y,n,xinc,yinc,xmin,ymin,xmax,ymax,eb,cb)
  use greg_interfaces, except_this=>find_mapchar8
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer :: n                      !
  real(8) :: x(n)                    !
  real(8) :: y(n)                    !
  real(8) :: xinc                    !
  real(8) :: yinc                    !
  real(8) :: xmin                    !
  real(8) :: ymin                    !
  real(8) :: xmax                    !
  real(8) :: ymax                    !
  real(8) :: eb                      !
  real(8) :: cb                      !
  ! Local
  real(8) :: l1,m1,l2,m2,val,d1,d2
  integer :: i,j
  !
  call find_siz8(x,y,n,xmin,xmax,ymin,ymax,eb,cb)
  !
  ! This algorithm is stupid: it compares all values two by two, so is of order N by N
  !
  ! The good trick is to build an histogram of values, which are presumably much less numerous
  ! (of order sqrt(N)) than N, since we build a regular grid.
  d1=xmax-xmin
  d2=ymax-ymin
  if (eb.lt.0.0d0) then
    do i=1,n-1
      l1=x(i)
      do j=i+1,n
        l2 = x(j)
        val = abs(l1-l2)
        if (val.ne.0d0) d1 = min(d1,val)
      enddo
    enddo
    do i=1,n-1
      m1=y(i)
      do j=i+1,n
        m2 = y(j)
        val = abs(m1-m2)
        if (val.ne.0d0) d2 = min(d2,val)
      enddo
    enddo
  else
    do i=1,n-1
      l1=x(i)
      if (abs(l1-cb).gt.eb) then
        do j=i+1,n
          l2 = x(j)
          if (abs(l2-cb).gt.eb) then
            val = abs(l1-l2)
            if (val.ne.0d0)  d1 = min(d1,val)
          endif
        enddo
      endif
    enddo
    do i=1,n-1
      m1=y(i)
      if (abs(m1-cb).gt.eb) then
        do j=i+1,n
          m2 = y(j)
          if (abs(m2-cb).gt.eb) then
            val = abs(m1-m2)
            if (val.ne.0d0)  d2 = min(d2,val)
          endif
        enddo
      endif
    enddo
  endif
  xinc=d1
  yinc=d2
  return
end subroutine find_mapchar8
!
subroutine find_siz8(x,y,n,xmin,xmax,ymin,ymax,eb,cb)
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer :: n                      !
  real(8) :: x(n)                    !
  real(8) :: y(n)                    !
  real(8) :: xmin                    !
  real(8) :: xmax                    !
  real(8) :: ymin                    !
  real(8) :: ymax                    !
  real(8) :: eb                      !
  real(8) :: cb                      !
  ! Local
  real(8) :: l1,m1,l2,m2
  integer :: i
  !
  if(eb.lt.0.0d0)then
    l1=x(1)
    m1=y(1)
    l2=l1
    m2=m1
    do i=2,n
      l1=min(l1,x(i))
      l2=max(l2,x(i))
      m1=min(m1,y(i))
      m2=max(m2,y(i))
    enddo
  else
    l1=cb
    i=0
    do while(abs(l1-cb).le.eb.and.i.lt.n)
      i=i+1
      l1=x(i)
    enddo
    m1=cb
    i=0
    do while(abs(m1-cb).le.eb.and.i.lt.n)
      i=i+1
      m1=y(i)
    enddo
    l2=l1
    m2=m1
    do i=1,n
      if (abs(x(i)-cb).gt.eb)then
        l1=min(l1,x(i))
        l2=max(l2,x(i))
      endif
      if (abs(y(i)-cb).gt.eb) then
        m1=min(m1,y(i))
        m2=max(m2,y(i))
      endif
    enddo
  endif
  xmin=l1
  ymin=m1
  xmax=l2
  ymax=m2
  return
end subroutine find_siz8
!
subroutine reallocate_rgdata(mx,my,error)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>reallocate_rgdata
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  !  (Re)allocate the RG buffer, taking care of its previous allocation
  ! status.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: mx     !
  integer(kind=4), intent(in)    :: my     !
  logical,         intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='RGDATA'
  character(len=message_length) :: mess
  integer(kind=4) :: ier
  logical :: alloc,error2
  integer(kind=index_length) :: dims(4)
  !
  if (mx.le.0 .or. my.le.0) then
    write(mess,'(A,I0,A,I0,A)')  &
      'Can not allocate null or negative size (got ',mx,' x ',my,')'
    call greg_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  alloc = .true.
  if (rg%status.eq.code_pointer_allocated) then
    if (ubound(rg%data,1).eq.mx .and. ubound(rg%data,2).eq.my) then
      alloc = .false.
    else
      deallocate(rg%data)
      rg%status = code_pointer_null
    endif
  elseif (rg%status.eq.code_pointer_associated) then
    rg%data => null()
    rg%status = code_pointer_null
  endif
  !
  if (alloc) then
    error2 = .false.
    call sic_delvariable('RG',.false.,error2)
    call sic_delvariable('NXRG',.false.,error2)
    call sic_delvariable('NYRG',.false.,error2)
    !
    allocate(rg%data(mx,my),stat=ier)
    if (failed_allocate(rname,'RGDATA',ier,error))  return
    rg%status = code_pointer_allocated
    !
    dims(1) = mx
    dims(2) = my
    call sic_def_real('RG',rg%data,2,dims,.false.,error)
    call sic_def_inte('NXRG',rg%nx,0,dims,.true.,error)
    call sic_def_inte('NYRG',rg%ny,0,dims,.true.,error)
  endif
  rg%nx = mx
  rg%ny = my
  !
  ! Always forget the previous min/max values, data is probably being
  ! changed
  rg%minmax = .false.
  !
end subroutine reallocate_rgdata
!
subroutine reassociate_rgdata(rgbuf,mx,my,error)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>reassociate_rgdata
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  !  (Re)associate the RG buffer, taking care of its previous allocation
  ! status.
  ! ---
  !  Bug fix. Using an explicit-shape dummy argument
  !     real(kind=4), intent(in), target :: rgbuf(mx,my)
  ! and pointing to it:
  !     rg%data => rgbuf
  ! is processor-dependent according to the Fortran. See Fortran 2003
  ! Section 12.4.1.2:
  !  "If the dummy argument has the TARGET attribute and is an
  ! explicit-shape array or is an assumed-size array, and the corresponding
  ! actual argument has the TARGET attribute but is not an array section
  ! with a vector subscript then:
  !   1) [...]
  !   2) when execution of the procedure completes, the pointer association
  !      status of any pointer that is pointer associated with the dummy
  !      argument is processor dependent."
  ! In other words, when sending the data array to the subroutine, the
  ! caller may send a copy of the actual argument, so that the dummy
  ! argument is contiguous and satisfies the explicit-shape declaration.
  !
  !   Ifort 9.0 to 14.0.1 (at least): seems indeed affected by this. The
  ! association status "seems" correct in return, but according to the
  ! standard the pointer association status is undefined (i.e. not
  ! reliable). In practice, a subsequent deallocation of the pointer
  ! fails if the allocation has been stealed to the target in the
  ! context:
  !  pointer :: a,b
  !  allocate(a)
  !  b => a
  !  deallocate(b)
  ! This is done in some cases.
  !
  !  On the other hand, one can use an assumed-shape dummy argument:
  !    real(kind=4), intent(in), target :: rgbuf(:,:)
  ! In this case, the caller knows the interface and can send the actual
  ! array (maybe with strides and boundaries specific to the call), so
  ! that it is not a problem to associate a pointer.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)         :: mx          !
  integer(kind=4), intent(in)         :: my          !
  real(kind=4),    intent(in), target :: rgbuf(:,:)  !
  logical,         intent(inout)      :: error       !
  ! Local
  character(len=*), parameter :: rname='RGDATA'
  character(len=message_length) :: mess
  logical :: error2
  integer(kind=index_length) :: dims(4)
  !
  if (mx.le.0 .or. my.le.0) then
    write(mess,'(A,I0,A,I0,A)')  &
      'Can not associate to null or negative size (got ',mx,' x ',my,')'
    call greg_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  error2 = .false.
  call sic_delvariable('RG',.false.,error2)
  call sic_delvariable('NXRG',.false.,error2)
  call sic_delvariable('NYRG',.false.,error2)
  !
  if (rg%status.eq.code_pointer_allocated)  deallocate(rg%data)
  !
  rg%data => rgbuf
  rg%status = code_pointer_associated
  !
  dims(1) = mx
  dims(2) = my
  call sic_def_real('RG',rg%data,2,dims,.false.,error)
  call sic_def_inte('NXRG',rg%nx,0,dims,.true.,error)
  call sic_def_inte('NYRG',rg%ny,0,dims,.true.,error)
  !
  rg%nx = mx
  rg%ny = my
  !
  ! Always forget the previous min/max values, data is probably being
  ! changed
  rg%minmax = .false.
  !
end subroutine reassociate_rgdata
!
subroutine deallocate_rgdata(error)
  use gildas_def
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>deallocate_rgdata
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  !  Deallocate the RG buffer, taking care of its previous allocation
  ! status.
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  !
  ! Local
  logical :: error2
  !
  error2 = .false.
  call sic_delvariable('RG',.false.,error2)
  call sic_delvariable('NXRG',.false.,error2)
  call sic_delvariable('NYRG',.false.,error2)
  !
  if (rg%status.eq.code_pointer_allocated) then
    deallocate(rg%data)
    rg%status = code_pointer_null
  elseif (rg%status.eq.code_pointer_associated) then
    rg%data => null()
    rg%status = code_pointer_null
  endif
  !
  rg%nx = 0
  rg%ny = 0
  !
  rg%minmax = .false.
  !
end subroutine deallocate_rgdata
