subroutine gr8_give(name,n,a)
  use greg_dependencies_interfaces
  use greg_interfaces
  use gildas_def
  use greg_error
  use greg_xyz
  use gbl_message
  !---------------------------------------------------------------------
  ! @ no-interface (because of type mismatch)
  !---------------------------------------------------------------------
  character(len=*) :: name          !
  integer(kind=4) :: n                      !
  real(kind=8) :: a(*)                    !
  ! Local
  character(len=60) :: chain
  logical :: doit,error
  real(kind=8), pointer :: mycolumn(:)
  !
  error = .false.
  if (n.gt.maxxy) then
    call delete_xyz (.true.,error)
    call more_xyz(n,error)
  endif
  if (name.ne.'X' .and. name.ne.'Y' .and. name.ne.'Z') then
    chain = 'Unknown array '//name
    call greg_message(seve%w,'GR8_GIVE',chain)
    return
  endif
  doit = n.ne.nxy
  call delete_xyz (doit,errorg)
  if (errorg) return           ! don't exit, leave user time to call GR_ERROR
  if (name.eq.'X') then
    mycolumn => column_x
  elseif (name.eq.'Y') then
    mycolumn => column_y
  elseif (name.eq.'Z') then
    if (.not.associated(column_z)) then
      doit = .true.
      call delete_xyz (doit,error)
      column_z => column_xyz(:,3)
    endif
    mycolumn => column_z
  endif
  call r8tor8(a,mycolumn,n)
  nxy = n
  if (doit) call create_xyz(error)
end subroutine gr8_give
!
subroutine gr4_give(name,n,a)
  use greg_dependencies_interfaces
  use greg_interfaces
  use gildas_def
  use greg_error
  use greg_xyz
  use gbl_message
  !---------------------------------------------------------------------
  ! @ no-interface (because of type mismatch)
  !---------------------------------------------------------------------
  character(len=*) :: name          !
  integer(kind=4) :: n                      !
  real(kind=4) :: a(*)                    !
  ! Local
  character(len=60) :: chain
  logical :: doit,error
  real(kind=8), pointer :: mycolumn(:)
  !
  error = .false.
  if (n.gt.maxxy) then
    call delete_xyz (.true.,error)
    call more_xyz(n,error)
  endif
  if (name.ne.'X' .and. name.ne.'Y' .and. name.ne.'Z') then
    chain = 'Unknown array '//name
    call greg_message(seve%w,'GR4_GIVE',chain)
    return
  endif
  doit = n.ne.nxy
  call delete_xyz (doit,errorg)
  if (errorg) return           ! don't exit, leave user time to call GR_ERROR
  if (name.eq.'X') then
    mycolumn => column_x
  elseif (name.eq.'Y') then
    mycolumn => column_y
  elseif (name.eq.'Z') then
    if (.not.associated(column_z)) then
      doit = .true.
      call delete_xyz (doit,error)
      column_z => column_xyz(:,3)
    endif
    mycolumn => column_z
  endif
  call r4tor8(a,mycolumn,n)
  nxy = n
  if (doit) call create_xyz(error)
end subroutine gr4_give
!
subroutine gr8_get(name,n,a)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>gr8_get
  use gildas_def
  use greg_error
  use greg_xyz
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  character(len=*) :: name          !
  integer(kind=4) :: n                      !
  real(kind=8) :: a(*)                    !
  ! Local
  character(len=60) :: chain
  integer(kind=4) :: i
  real(kind=8), pointer :: mycolumn(:)
  !
  if (nxy.gt.n) then
    call greg_message(seve%e,'GR8_GET','Too many values in X, Y or Z array')
    errorg = .true.
    return                     ! don't exit, leave user time to call GR_ERROR
  endif
  if (name.ne.'X' .and. name.ne.'Y' .and. name.ne.'Z') then
    chain = 'Unknown array '//name
    call greg_message(seve%w,'GR8_GET',chain)
    return
  endif
  if (name.eq.'X') then
    mycolumn => column_x
  elseif (name.eq.'Y') then
    mycolumn => column_y
  elseif (name.eq.'Z') then
    if (.not.associated(column_z)) then
      do i=1,nxy
        a(i)=0.
      enddo
      mycolumn => null()
    else
      mycolumn => column_z
    endif
  endif
  if (associated(mycolumn)) call r8tor8(mycolumn,a,nxy)
  n = nxy
end subroutine gr8_get
!
subroutine gr4_get(name,n,a)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>gr4_get
  use gildas_def
  use greg_error
  use greg_xyz
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  character(len=*) :: name          !
  integer(kind=4) :: n                      !
  real(kind=4) :: a(*)                    !
  ! Local
  character(len=60) :: chain
  integer(kind=4) :: i
  real(kind=8), pointer :: mycolumn(:)
  !
  if (nxy.gt.n) then
    call greg_message(seve%e,'GR4_SET','Too many values in X, Y or Z array')
    errorg = .true.
    return                     ! don't exit, leave user time to call GR_ERROR
  endif
  if (name.ne.'X' .and. name.ne.'Y' .and. name.ne.'Z') then
    chain = 'Unknown array '//name
    call greg_message(seve%w,'GR4_GET',chain)
    return
  endif
  if (name.eq.'X') then
    mycolumn => column_x
  elseif (name.eq.'Y') then
    mycolumn => column_y
  elseif (name.eq.'Z') then
    if (.not.associated(column_z)) then
      do i=1,nxy
        a(i)=0.
      enddo
      mycolumn => null()
    else
      mycolumn => column_z
    endif
  endif
  if (associated(mycolumn)) call r8tor4(mycolumn,a,nxy)
  n = nxy
end subroutine gr4_get
!
subroutine gr8_tgive(ix,iy,conv,zdata)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces
  use greg_error
  use greg_rg
  !---------------------------------------------------------------------
  ! @ no-interface (because of type mismatch)
  ! (re)define the RG, NXRG and NYRG variable with the (Temporary) input
  ! Fortran array. This array is duplicated the internal Greg buffer
  ! associated to the RG.
  !---------------------------------------------------------------------
  integer(kind=4) :: ix                   !
  integer(kind=4) :: iy                   !
  real(kind=8) :: conv(6)                 !
  real(kind=8) :: zdata(*)                !
  ! Local
  character(len=*), parameter :: rname='GR8_TGIVE'
  character(len=256) :: chain
  !
  if (ix.le.1 .or. iy.le.1) then
    if (locwrd(zdata).eq.0) then
      call greg_message(seve%w,rname,'Regular grid array unloaded')
      call rg%deallocate(errorg)
      return
    elseif (ix.lt.1 .or. iy.lt.1) then
      write(chain,'(A,I6,A,I6)') 'Dimension error NX ',ix,' NY ',iy
      call greg_message(seve%e,rname,chain)
      errorg = .true.
      return
    endif
  endif
  !
  call reallocate_rgdata(ix,iy,errorg)
  if (errorg)  return
  !
  call r8tor4(zdata,rg%data,ix*iy)
  rg%xref = conv(1)
  rg%xval = conv(2)
  rg%xinc = conv(3)
  rg%yref = conv(4)
  rg%yval = conv(5)
  rg%yinc = conv(6)
  !
end subroutine gr8_tgive
!
subroutine gr4_tgive(ix,iy,conv,zdata)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces
  use greg_error
  use greg_rg
  !---------------------------------------------------------------------
  ! @ no-interface (because of type mismatch)
  ! (re)define the RG, NXRG and NYRG variable with the (Temporary) input
  ! Fortran array. This array is duplicated the internal Greg buffer
  ! associated to the RG.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: ix        ! X size of array
  integer(kind=4), intent(in) :: iy        ! Y size of array
  real(kind=8),    intent(in) :: conv(6)   ! Axes definition
  real(kind=4),    intent(in) :: zdata(*)  ! Array values ix*iy
  ! Local
  character(len=*), parameter :: rname='GR4_TGIVE'
  character(len=256) :: chain
  !
  if (ix.le.1 .or. iy.le.1) then
    if (locwrd(zdata).eq.0) then
      call greg_message(seve%w,rname,'Regular grid array unloaded')
      call rg%deallocate(errorg)
      return
    elseif (ix.lt.1 .or. iy.lt.1) then
      write(chain,'(A,I6,A,I6)') 'Dimension error NX ',ix,' NY ',iy
      call greg_message(seve%e,rname,chain)
      errorg = .true.
      return
    endif
  endif
  !
  call reallocate_rgdata(ix,iy,errorg)
  if (errorg) return
  !
  call r4tor4(zdata,rg%data,ix*iy)
  rg%xref = conv(1)
  rg%xval = conv(2)
  rg%xinc = conv(3)
  rg%yref = conv(4)
  rg%yval = conv(5)
  rg%yinc = conv(6)
end subroutine gr4_tgive
!
subroutine gi4_tgive(ix,iy,conv,zdata)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces
  use greg_error
  use greg_rg
  !---------------------------------------------------------------------
  ! @ no-interface (because of type mismatch)
  ! (re)define the RG, NXRG and NYRG variable with the (Temporary) input
  ! Fortran array. This array is duplicated the internal Greg buffer
  ! associated to the RG.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: ix        ! X size of array
  integer(kind=4), intent(in) :: iy        ! Y size of array
  real(kind=8),    intent(in) :: conv(6)   ! Axes definition
  integer(kind=4), intent(in) :: zdata(*)  ! Array values ix*iy
  ! Local
  character(len=*), parameter :: rname='GI4_TGIVE'
  character(len=256) :: chain
  !
  if (ix.le.1 .or. iy.le.1) then
    if (locwrd(zdata).eq.0) then
      call greg_message(seve%w,rname,'Regular grid array unloaded')
      call rg%deallocate(errorg)
      return
    elseif (ix.lt.1 .or. iy.lt.1) then
      write(chain,'(A,I6,A,I6)') 'Dimension error NX ',ix,' NY ',iy
      call greg_message(seve%e,rname,chain)
      errorg = .true.
      return
    endif
  endif
  !
  call reallocate_rgdata(ix,iy,errorg)
  if (errorg) return
  !
  call i4tor4(zdata,rg%data,ix*iy)
  rg%xref = conv(1)
  rg%xval = conv(2)
  rg%xinc = conv(3)
  rg%yref = conv(4)
  rg%yval = conv(5)
  rg%yinc = conv(6)
end subroutine gi4_tgive
!
subroutine gi8_tgive(ix,iy,conv,zdata)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces
  use greg_error
  use greg_rg
  !---------------------------------------------------------------------
  ! @ no-interface (because of type mismatch)
  ! (re)define the RG, NXRG and NYRG variable with the (Temporary) input
  ! Fortran array. This array is duplicated the internal Greg buffer
  ! associated to the RG.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: ix        ! X size of array
  integer(kind=4), intent(in) :: iy        ! Y size of array
  real(kind=8),    intent(in) :: conv(6)   ! Axes definition
  integer(kind=8), intent(in) :: zdata(*)  ! Array values ix*iy
  ! Local
  character(len=*), parameter :: rname='GI8_TGIVE'
  character(len=256) :: chain
  !
  if (ix.le.1 .or. iy.le.1) then
    if (locwrd(zdata).eq.0) then
      call greg_message(seve%w,rname,'Regular grid array unloaded')
      call rg%deallocate(errorg)
      return
    elseif (ix.lt.1 .or. iy.lt.1) then
      write(chain,'(A,I6,A,I6)') 'Dimension error NX ',ix,' NY ',iy
      call greg_message(seve%e,rname,chain)
      errorg = .true.
      return
    endif
  endif
  !
  call reallocate_rgdata(ix,iy,errorg)
  if (errorg) return
  !
  call i8tor4(zdata,rg%data,ix*iy)
  rg%xref = conv(1)
  rg%xval = conv(2)
  rg%xinc = conv(3)
  rg%yref = conv(4)
  rg%yval = conv(5)
  rg%yinc = conv(6)
end subroutine gi8_tgive
!
subroutine gr4_rgive(ix,iy,conv,zdata)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces
  use greg_error
  use greg_rg
  !---------------------------------------------------------------------
  ! @ no-interface (because of type mismatch)
  ! (re)define the RG, NXRG and NYRG variable with the input Fortran
  ! array. This array is refered as the new RG array (pointer), which
  ! means that the calling routine must NOT delete it as long as
  ! the RG variable exists.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: ix            ! X size of array
  integer(kind=4), intent(in) :: iy            ! Y size of array
  real(kind=8),    intent(in) :: conv(6)       ! Axes definition
  real(kind=4),    intent(in) :: zdata(ix,iy)  ! Array values ix*iy
  ! Local
  character(len=*), parameter :: rname='GR4_RGIVE'
  character(len=256) :: chain
  !
  if (ix.le.1 .or. iy.le.1) then
    if (locwrd(zdata).eq.0) then
      call greg_message(seve%w,rname,'Regular grid array unloaded')
      call rg%deallocate(errorg)
      return
    elseif (ix.lt.1 .or. iy.lt.1) then
      write(chain,'(A,I6,A,I6)') 'Dimension error NX ',ix,' NY ',iy
      call greg_message(seve%e,rname,chain)
      errorg = .true.
      return
    endif
  endif
  !
  call reassociate_rgdata(zdata,ix,iy,errorg)
  if (errorg)  return
  !
  rg%xref = conv(1)
  rg%xval = conv(2)
  rg%xinc = conv(3)
  rg%yref = conv(4)
  rg%yval = conv(5)
  rg%yinc = conv(6)
end subroutine gr4_rgive
!
subroutine gr8_tgivesub(kx,ky,conv,zdata,nx1,nx2,ny1,ny2)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces
  use greg_error
  use greg_rg
  !---------------------------------------------------------------------
  ! @ no-interface (because of type mismatch)
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: kx  !
  integer(kind=index_length), intent(in) :: ky  !
  real(kind=8) :: conv(6)                 !
  real(kind=8) :: zdata(*)                !
  integer(kind=4) :: nx1                  !
  integer(kind=4) :: nx2                  !
  integer(kind=4) :: ny1                  !
  integer(kind=4) :: ny2                  !
  ! Local
  integer(kind=4) :: ix,iy
  integer(kind=index_length) :: infx,supx,infy,supy
  !
  infx = min(nx1,nx2)
  infy = min(ny1,ny2)
  supx = max(nx1,nx2)
  supy = max(ny1,ny2)
  if (infx.lt.1 .or. supx.gt.kx .or. infy.lt.1 .or. supy.gt.ky) then
    call greg_message(seve%e,'RGDATA','Map subset does not lie in the map')
    errorg = .true.
    return
  endif
  ix = supx-infx+1
  iy = supy-infy+1
  !
  call reallocate_rgdata(ix,iy,errorg)
  if (errorg)  return
  !
  call subset8(zdata,kx,ky,rg%data,ix,iy,infx,supx,infy,supy)
  rg%xref = conv(1)+(1-infx)
  rg%yref = conv(4)+(1-infy)
  rg%xval = conv(2)
  rg%xinc = conv(3)
  rg%yval = conv(5)
  rg%yinc = conv(6)
end subroutine gr8_tgivesub
!
subroutine gr4_rgivesub(kx,ky,conv,zdata,nx1,nx2,ny1,ny2)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces
  use greg_error
  use greg_rg
  !---------------------------------------------------------------------
  ! @ no-interface (because of type mismatch)
  ! Note that the name is Rgivesub since we always allocate memory for the
  ! subset.
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: kx  !
  integer(kind=index_length), intent(in) :: ky  !
  real(kind=8) :: conv(6)                 !
  real(kind=4) :: zdata(*)                !
  integer(kind=4) :: nx1                  !
  integer(kind=4) :: nx2                  !
  integer(kind=4) :: ny1                  !
  integer(kind=4) :: ny2                  !
  ! Local
  integer(kind=4) :: ix,iy
  integer(kind=index_length) :: infx,supx,infy,supy
  !
  infx = min(nx1,nx2)
  infy = min(ny1,ny2)
  supx = max(nx1,nx2)
  supy = max(ny1,ny2)
  if (infx.lt.1 .or. supx.gt.kx .or. infy.lt.1 .or. supy.gt.ky) then
    call greg_message(seve%e,'RGDATA','Map subset does not lie in the map')
    errorg = .true.
    return
  endif
  ix = supx-infx+1
  iy = supy-infy+1
  !
  call reallocate_rgdata(ix,iy,errorg)
  if (errorg) return
  !
  call subset4(zdata,kx,ky,rg%data,ix,iy,infx,supx,infy,supy)
  rg%xref = conv(1)+(1-infx)
  rg%yref = conv(4)+(1-infy)
  rg%xval = conv(2)
  rg%xinc = conv(3)
  rg%yval = conv(5)
  rg%yinc = conv(6)
end subroutine gr4_rgivesub
!
subroutine greg_projec(pcode,proj)
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces
  use greg_error
  use greg_wcs
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch: a0,d0,pang in sequence)
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: pcode    ! Projection code
  real(kind=8),    intent(in) :: proj(3)  ! a0,d0,pang
  ! Local
  logical :: error
  !
  error = .false.
  call gwcs_projec(proj(1),proj(2),proj(3),pcode,gproj,error)
  call setrem
end subroutine greg_projec
!
subroutine greg_projec_get(proj)
  use gwcs_types
  use greg_wcs
  !---------------------------------------------------------------------
  ! @ public (for Astro)
  !  Return the current projection status in Greg
  !---------------------------------------------------------------------
  type(projection_t), intent(out) :: proj
  proj = gproj
end subroutine greg_projec_get
!
subroutine gr8_system(icode,error,equinox)
  use gbl_constant
  use gbl_message
  use greg_interfaces, except_this=>gr8_system
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)           :: icode    !
  logical,         intent(inout)        :: error    !
  real(kind=4),    intent(in), optional :: equinox  !
  !
  select case (icode)
  case (type_un,type_eq,type_ga,type_ic)
    continue
  case default
    call greg_message(seve%e,'GR8_SYSTEM','Coordinate system is not supported')
    error = .true.
    return
  end select
  !
  if (present(equinox)) then
    call setsys(icode,equinox)
  else
    call setsys(icode)
  endif
end subroutine gr8_system
!
subroutine gr8_blanking (xbval,xeval)
  use greg_interfaces, except_this=>gr8_blanking
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  real(kind=8) :: xbval                   !
  real(kind=8) :: xeval                   !
  call setbla(xbval,xeval)
end subroutine gr8_blanking
!
subroutine gr4_sub_extrema(z,n,m,bval,eval,zmin,zmax,i1,i2,j1,j2)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>gr4_sub_extrema
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer(kind=4) :: n                      !
  integer(kind=4) :: m                      !
  real(kind=4) :: z(n,m)                  !
  real(kind=4) :: bval                    !
  real(kind=4) :: eval                    !
  real(kind=4) :: zmin                    !
  real(kind=4) :: zmax                    !
  integer(kind=4) :: i1                     !
  integer(kind=4) :: i2                     !
  integer(kind=4) :: j1                     !
  integer(kind=4) :: j2                     !
  ! Local
  integer(kind=4) :: i,j,k
  !
  !     Protect against NaN and INFs even without blanking. Silent.
  !
  zmin=0.0
  zmax=0.0
  do j=j1,j2
    do i=i1,i2
      if (sic_fini4(z(i,j)).and.(abs(z(i,j)-bval).gt.eval))then
        zmin = z(i,j)
        zmax = z(i,j)
        goto 10
      endif
    enddo
  enddo
  !
10 continue
  do i=j,j2
    do k=i1,i2
      if (sic_fini4(z(k,i)) .and. (abs(z(k,i)-bval).gt.eval)) then
        if (z(k,i).lt.zmin) then
          zmin = z(k,i)
        elseif (z(k,i).gt.zmax) then
          zmax = z(k,i)
        endif
      endif
    enddo
  enddo
end subroutine gr4_sub_extrema
!
subroutine subset4 (x,nx,ny,y,mx,my,i1,i2,j1,j2)
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private
  ! GILDAS Internal routine
  ! Extract a two dimensional subset from a two dimensional image
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in)  :: nx,ny     ! Dimensions of X
  real(kind=4),               intent(in)  :: x(nx,ny)  ! Input array
  integer(kind=4),            intent(in)  :: mx,my     ! Dimensions of Y
  real(kind=4),               intent(out) :: y(mx,my)  ! Output subset
  integer(kind=index_length), intent(in)  :: i1,i2     ! Min and Max pixels along first axis
  integer(kind=index_length), intent(in)  :: j1,j2     ! Min and Max pixels along second axis
  ! Local
  integer(kind=index_length) :: i,j,k,l
  !
  l = 0
  do j = j1,j2
    l = l+1
    k = 0
    do i=i1,i2
      k = k+1
      y(k,l) = x(i,j)
    enddo
  enddo
end subroutine subset4
!
subroutine subset8(x,nx,ny,y,mx,my,i1,i2,j1,j2)
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private
  ! GILDAS Internal routine
  ! Extract a two dimensional subset from a two dimensional image
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in)  :: nx,ny     ! Dimensions of X
  real(kind=8),               intent(in)  :: x(nx,ny)  ! Input array
  integer(kind=4),            intent(in)  :: mx,my     ! Dimensions of Y
  real(kind=4),               intent(out) :: y(mx,my)  ! Output subset
  integer(kind=index_length), intent(in)  :: i1,i2     ! Min and Max pixels along first axis
  integer(kind=index_length), intent(in)  :: j1,j2     ! Min and Max pixels along second axis
  ! Local
  integer(kind=index_length) :: i,j,k,l
  !
  l = 0
  do j = j1,j2
    l = l+1
    k = 0
    do i=i1,i2
      k = k+1
      y(k,l) = x(i,j)
    enddo
  enddo
end subroutine subset8
