subroutine ghisto(line,error)
  use gildas_def
  use gbl_format
  use phys_const
  use gbl_message
  use sic_types
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>ghisto,  &
                       no_interface1=>gr8_histo,  &
                       no_interface2=>gr8_yxhisto,  &
                       no_interface3=>gr8_histo_base,  &
                       no_interface4=>gr8_yxhisto_base,  &
                       no_interface5=>gr8_histo_hatchfill,  &
                       no_interface6=>gr8_yxhisto_hatchfill
  use greg_kernel
  use greg_pen
  use greg_types
  use greg_xyz
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !   HISTOGRAM [Array_X Array_Y]
  ! 1   [/BLANKING  Bval Eval]
  ! 2   [/FILL [Icolor]]
  ! 3   [/BASE [Base]]
  ! 4   [/HATCH [Ipen] [Angle] [Separ] [Phase]]
  ! 5   [/Y]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   !
  logical,          intent(inout) :: error  !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='HISTOGRAM'
  integer(kind=size_length) :: ixy,nbase
  integer(kind=4) :: form,narg,icol_old,ipen_old,nxy4
  type(sic_descriptor_t) :: xinca,yinca,basedesc
  integer(kind=address_length) :: ipx,ipy
  real(kind=8) :: bval,eval
  type(polygon_drawing_t) :: drawing
  logical :: yxhisto
  real(kind=8), allocatable :: base(:)
  integer(kind=4), parameter :: optblank=1
  integer(kind=4), parameter :: optfill=2
  integer(kind=4), parameter :: optbase=3
  integer(kind=4), parameter :: opthatch=4
  integer(kind=4), parameter :: opty=5
  !
  save xinca,yinca
  !
  ! Command line parsing
  narg = sic_narg(0)
  if (narg.ne.0 .and. narg.ne.2)  return
  !
  ! /BLANK options
  bval = cblank
  call sic_r8 (line,optblank,1,bval,.false.,error)
  if (error) return
  eval = eblank
  call sic_r8 (line,optblank,2,eval,.false.,error)
  if (error) return
  !
  ! /FILL and /HATCH options
  if (penupd) call setpen(cpen)
  call inqcol(icol_old)
  call inqpen(ipen_old)
  call parse_polygon_drawing(rname,line,optfill,opthatch,drawing,error)
  if (error)  return
  !
  ! /Y option
  yxhisto = sic_present(opty,0)
  !
  ! Command arguments (X and Y arrays)
  form = fmt_r8
  call get_incarnation('HISTOGRAM',line,form,ixy,xinca,yinca,error)
  if (error) return
  ipx = gag_pointer(xinca%addr,memory)
  ipy = gag_pointer(yinca%addr,memory)
  call gr8_histo_sanity(ixy,memory(ipx),memory(ipy),yxhisto,error)
  if (error)  return
  !
  ! /BASE option: argument can be scalar or 1D
  if (.not.sic_present(optbase,1)) then
    nbase = 1
    allocate(base(nbase))
    base(:) = 0.d0
  else
    call sic_de(line,optbase,1,basedesc,.true.,error)
    if (error)  goto 10
    if (desc_nelem(basedesc).eq.1) then
      nbase = 1
      allocate(base(nbase))
      call sic_descriptor_getval(basedesc,base,error)
      if (error)  goto 10
    elseif (basedesc%ndim.eq.1) then
      nbase = basedesc%dims(1)
      if (nbase.ne.ixy) then
        call greg_message(seve%e,rname,  &
          '/BASE argument must be scalar or same size as X and Y arrays')
        error = .true.
        goto 10
      endif
      allocate(base(nbase))
      call sic_descriptor_getval(basedesc,base,error)
      if (error)  goto 10
    else
      call greg_message(seve%e,rname,'/BASE argument must scalar or 1D')
      error = .true.
      goto 10
    endif
  endif
  !
  call gr_segm(rname,error)
  if (error)  goto 10
  !
  if (drawing%hatched) then  ! /HATCH (+ maybe /FILL)
    if (drawing%filled) then
      ! Hatch+Fill = color filled histogram (base assumed)
      drawing%hatched = .false. ! Temporarily disable hatching (segment colour issue)
      call setcol(drawing%fcolor)
      if (yxhisto) then
        call gr8_yxhisto_hatchfill(ixy,memory(ipx),memory(ipy),nbase,base,bval,eval,drawing,error)
      else
        call gr8_histo_hatchfill(ixy,memory(ipx),memory(ipy),nbase,base,bval,eval,drawing,error)
      endif
      !
      ! New segment (may have different colors)
      call gtsegm_close(error)
      call setcol(icol_old)  ! Reset color *after* closing the segment
      call gr_segm(rname,error)
      drawing%hatched = .true. ! Reenabled
    endif
    !
    drawing%filled = .false. ! Disable filling (segment colour issue)
    call setpen(drawing%hpen)
    if (yxhisto) then
      call gr8_yxhisto_hatchfill(ixy,memory(ipx),memory(ipy),nbase,base,bval,eval,drawing,error)
    else
      call gr8_histo_hatchfill(ixy,memory(ipx),memory(ipy),nbase,base,bval,eval,drawing,error)
    endif
    if (error)  continue
    !
  elseif (sic_present(optbase,0)) then  ! /BASE
    if (drawing%filled) then  ! /FILL
      ! Base+Fill = color filled histogram
      call setcol(drawing%fcolor)
      if (yxhisto) then
        call gr8_yxhisto_hatchfill(ixy,memory(ipx),memory(ipy),nbase,base,bval,eval,drawing,error)
      else
        call gr8_histo_hatchfill(ixy,memory(ipx),memory(ipy),nbase,base,bval,eval,drawing,error)
      endif
    else
      if (yxhisto) then
        call gr8_yxhisto_base(ixy,memory(ipx),memory(ipy),nbase,base,bval,eval)
      else
        call gr8_histo_base(ixy,memory(ipx),memory(ipy),nbase,base,bval,eval)
      endif
    endif
    !
  else
    ! No Base (maybe fill): top of histogram (maybe colored)
    if (drawing%filled)  call setcol(drawing%fcolor)
    nxy4 = ixy
    if (yxhisto) then
      call gr8_yxhisto(nxy4,memory(ipx),memory(ipy),bval,eval)
    else
      call gr8_histo(nxy4,memory(ipx),memory(ipy),bval,eval)
    endif
  endif
  !
  call gtsegm_close(error)
  !
10 continue
  ! Reset pen *after* closing the segment
  call setpen(ipen_old)
  call setcol(icol_old)
  !
  call sic_volatile(xinca)
  call sic_volatile(yinca)
  call sic_volatile(basedesc)
end subroutine ghisto
!
subroutine gr8_histo_sanity(nxy,x,y,yxhisto,error)
  use gildas_def
  use gbl_message
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !  Check if bin coordinates are monotoneous (HISTOGRAM does not work
  ! properly if not).
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: nxy      ! Number of points
  real(kind=8),              intent(in)    :: x(nxy)   ! X array
  real(kind=8),              intent(in)    :: y(nxy)   ! Y array
  logical,                   intent(in)    :: yxhisto  ! XY or YX histogram?
  logical,                   intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='HISTOGRAM'
  character(len=1) :: bin_name,cnt_name
  logical :: cnt_monotonic
  !
  if (yxhisto) then
    ! XY histogram
    if (monotonic_array(nxy,y))  return
    bin_name = 'Y'
    cnt_monotonic = monotonic_array(nxy,x)
    cnt_name = 'X'
  else
    ! XY histogram
    if (monotonic_array(nxy,x))  return
    bin_name = 'X'
    cnt_monotonic = monotonic_array(nxy,y)
    cnt_name = 'Y'
  endif
  call greg_message(seve%e,rname,bin_name//' is not a monotonic array')
  if (cnt_monotonic)  call greg_message(seve%e,rname,  &
    cnt_name//' is monotonic: missing option /'//cnt_name//' ?')
  error = .true.
  return
  !
contains
  !
  function monotonic_array(nxy,array)
    logical :: monotonic_array
    integer(kind=size_length), intent(in) :: nxy
    real(kind=8),              intent(in) :: array(nxy)
    ! Local
    integer(kind=size_length) :: ixy
    !
    monotonic_array = .true.
    if (array(1).lt.array(nxy)) then
      do ixy=1,nxy-1
        if (array(ixy).gt.array(ixy+1)) then
          monotonic_array = .false.
          return
        endif
      enddo
    else
      do ixy=1,nxy-1
        if (array(ixy).lt.array(ixy+1)) then
          monotonic_array = .false.
          return
        endif
      enddo
    endif
  end function monotonic_array
  !
end subroutine gr8_histo_sanity
!
subroutine gr4_histo(nxy,x,y,bval,eval)
  use greg_interfaces, except_this=>gr4_histo
  !---------------------------------------------------------------------
  ! @ public
  !  Connect a set of points with blanked values using histogram (top of
  ! histogram is drawn). Support for blank values and NaN.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: nxy     ! Number of points
  real(kind=4),    intent(in) :: x(nxy)  ! Array of X coordinates
  real(kind=4),    intent(in) :: y(nxy)  ! Array of Y coordinates
  real(kind=4),    intent(in) :: bval    ! Blanking value
  real(kind=4),    intent(in) :: eval    ! Tolerance on blanking
  ! Local
  real(kind=8) :: xav,yav
  integer(kind=4) :: j
  logical :: up
  !
  if (nxy.lt.2) return
  !
  xav = x(1) - 0.5*(x(2)-x(1))
  if (y(1).eq.y(1).and.abs(y(1)-bval) .gt. eval) then
    yav = y(1)
    call relocate(xav,yav)
    up = .false.
  else
    up = .true.
  endif
  !
  do j = 2,nxy
    xav = 0.5 * (x(j)+x(j-1))
    if (y(j).eq.y(j).and.abs(y(j)-bval) .gt. eval) then
      if (up) then
        yav = y(j)
        call relocate(xav,yav)
        up = .false.
      else
        yav = y(j-1)
        call draw(xav,yav)
        yav = y(j)
        call draw(xav,yav)
      endif
    elseif (.not.up) then
      yav = y(j-1)
      call draw(xav,yav)
      up = .true.
    endif
  enddo
  if (up) return
  xav = x(nxy) + 0.5*(x(nxy)-x(nxy-1))
  yav = y(nxy)
  call draw(xav,yav)
end subroutine gr4_histo
!
subroutine gr8_histo(nxy,x,y,bval,eval)
  use greg_interfaces, except_this=>gr8_histo
  !---------------------------------------------------------------------
  ! @ public-mandatory
  !  Connect a set of points with blanked values using histogram (top of
  ! histogram is drawn). Support for blank values and NaN.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: nxy     ! Number of points
  real(kind=8),    intent(in) :: x(nxy)  ! Array of X coordinates
  real(kind=8),    intent(in) :: y(nxy)  ! Array of Y coordinates
  real(kind=8),    intent(in) :: bval    ! Blanking value
  real(kind=8),    intent(in) :: eval    ! Tolerance on blanking
  ! Local
  integer(kind=4) :: j
  real(kind=8) :: xav
  logical :: up
  !
  if (nxy.lt.2) return
  !
  ! Left of first bin
  xav = x(1) - 0.5d0*(x(2)-x(1))
  if ((y(1).eq.y(1)).and.abs(y(1)-bval).gt.eval) then
    call relocate(xav,y(1))
    up = .false.
  else
    up = .true.
  endif
  !
  ! Central bins
  do j = 2,nxy
    xav = 0.5d0 * (x(j)+x(j-1))
    if (y(j).eq.y(j).and.abs(y(j)-bval).gt.eval) then
      if (up) then
        call relocate(xav,y(j))
        up = .false.
      else
        call draw(xav,y(j-1))
        call draw(xav,y(j))
      endif
    elseif (.not.up) then
      call draw(xav,y(j-1))
      up = .true.
    endif
  enddo
  !
  ! Right of last bin
  xav = x(nxy) + 0.5d0*(x(nxy)-x(nxy-1))
  if (.not.up) call draw(xav,y(nxy))
end subroutine gr8_histo
!
subroutine gr8_yxhisto(nxy,x,y,bval,eval)
  use greg_interfaces, except_this=>gr8_yxhisto
  !---------------------------------------------------------------------
  ! @ public-mandatory
  !  Same as gr8_histo, but binning is along Y, and X provides the
  ! counts per bin. Bval/Eval apply on X.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: nxy     ! Number of points
  real(kind=8),    intent(in) :: x(nxy)  ! Array of X coordinates
  real(kind=8),    intent(in) :: y(nxy)  ! Array of Y coordinates
  real(kind=8),    intent(in) :: bval    ! Blanking value
  real(kind=8),    intent(in) :: eval    ! Tolerance on blanking
  ! Local
  integer(kind=4) :: j
  real(kind=8) :: yav
  logical :: up
  !
  if (nxy.lt.2) return
  !
  ! Left of first bin
  yav = y(1) - 0.5d0*(y(2)-y(1))
  if ((x(1).eq.x(1)).and.abs(x(1)-bval).gt.eval) then
    call relocate(x(1),yav)
    up = .false.
  else
    up = .true.
  endif
  !
  ! Central bins
  do j = 2,nxy
    yav = 0.5d0 * (y(j)+y(j-1))
    if (x(j).eq.x(j).and.abs(x(j)-bval).gt.eval) then
      if (up) then
        call relocate(x(j),yav)
        up = .false.
      else
        call draw(x(j-1),yav)
        call draw(x(j),yav)
      endif
    elseif (.not.up) then
      call draw(x(j-1),yav)
      up = .true.
    endif
  enddo
  !
  ! Right of last bin
  yav = y(nxy) + 0.5d0*(y(nxy)-y(nxy-1))
  if (.not.up) call draw(x(nxy),yav)
end subroutine gr8_yxhisto
!
subroutine gr8_histo_base(nxy,x,y,nbase,base,bval,eval)
  use gildas_def
  use greg_interfaces, except_this=>gr8_histo_base
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Connect a set of points with blanked values using histogram
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in) :: nxy          ! Number of points
  real(kind=8),              intent(in) :: x(nxy)       ! Array of X coordinates
  real(kind=8),              intent(in) :: y(nxy)       ! Array of Y coordinates
  integer(kind=size_length), intent(in) :: nbase        ! Number base points (1 or Nxy)
  real(kind=8),              intent(in) :: base(nbase)  ! Base value(s)
  real(kind=8),              intent(in) :: bval         ! Blanking value
  real(kind=8),              intent(in) :: eval         ! Tolerance on blanking
  ! Local
  real(kind=8) :: xav
  integer(kind=size_length) :: j
  integer(kind=4) :: sbase
  logical :: up
  integer(kind=size_length), parameter :: first=1
  !
  if (nxy.lt.2) return
  !
  xav = x(1) - 0.5d0*(x(2)-x(1))
  if (y(1).eq.y(1) .and. abs(y(1)-bval).gt.eval) then
    call relocate(xav,base(ibase(first)))
    call draw(xav,y(1))
    up = .false.
  else
    up = .true.
  endif
  !
  if (nbase.eq.nxy) then
    sbase = 1
  else
    sbase = 0
  endif
  !
  do j = 2,nxy
    xav = 0.5d0 * (x(j)+x(j-1))
    if (y(j).eq.y(j).and.abs(y(j)-bval) .gt. eval) then
      if (up) then
        call relocate(xav,base(ibase(j)))
        call draw(xav,y(j))
        up = .false.
      else
        call draw(xav,y(j-1))
        call draw(xav,base(ibase(j)))
        call draw(xav,y(j))
      endif
    elseif (.not.up) then
      call draw(xav,y(j-1))
      call draw(xav,base(ibase(j)))
      up = .true.
    endif
  enddo
  if (up) return
  xav = x(nxy) + 0.5d0*(x(nxy)-x(nxy-1))
  call draw(xav,y(nxy))
  call draw(xav,base(ibase(nxy)))
  !
contains
  function ibase(ival)
    !-------------------------------------------------------------------
    ! Return index in base arrray for ival-th of histogram
    !-------------------------------------------------------------------
    integer(kind=size_length) :: ibase
    integer(kind=size_length), intent(in) :: ival
    if (nbase.eq.nxy) then
      ibase = ival
    else
      ibase = 1
    endif
  end function ibase
end subroutine gr8_histo_base
!
subroutine gr8_yxhisto_base(nxy,x,y,nbase,base,bval,eval)
  use gildas_def
  use greg_interfaces, except_this=>gr8_yxhisto_base
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !  Same as gr8_histo_base, but binning is along Y, and X provides the
  ! counts per bin. Bval/Eval apply on X.
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in) :: nxy          ! Number of points
  real(kind=8),              intent(in) :: x(nxy)       ! Array of X coordinates
  real(kind=8),              intent(in) :: y(nxy)       ! Array of Y coordinates
  integer(kind=size_length), intent(in) :: nbase        ! Number base points (1 or Nxy)
  real(kind=8),              intent(in) :: base(nbase)  ! Base value(s)
  real(kind=8),              intent(in) :: bval         ! Blanking value
  real(kind=8),              intent(in) :: eval         ! Tolerance on blanking
  ! Local
  real(kind=8) :: yav
  integer(kind=size_length) :: j
  integer(kind=4) :: sbase
  logical :: up
  integer(kind=size_length), parameter :: first=1
  !
  if (nxy.lt.2) return
  !
  yav = y(1) - 0.5d0*(y(2)-y(1))
  if (x(1).eq.x(1) .and. abs(x(1)-bval).gt.eval) then
    call relocate(base(ibase(first)),yav)
    call draw(x(1),yav)
    up = .false.
  else
    up = .true.
  endif
  !
  if (nbase.eq.nxy) then
    sbase = 1
  else
    sbase = 0
  endif
  !
  do j = 2,nxy
    yav = 0.5d0 * (y(j)+y(j-1))
    if (x(j).eq.x(j).and.abs(x(j)-bval) .gt. eval) then
      if (up) then
        call relocate(base(ibase(j)),yav)
        call draw(y(j),yav)
        up = .false.
      else
        call draw(x(j-1),yav)
        call draw(base(ibase(j)),yav)
        call draw(x(j),yav)
      endif
    elseif (.not.up) then
      call draw(x(j-1),yav)
      call draw(base(ibase(j)),yav)
      up = .true.
    endif
  enddo
  if (up) return
  yav = y(nxy) + 0.5d0*(y(nxy)-y(nxy-1))
  call draw(x(nxy),yav)
  call draw(base(ibase(nxy)),yav)
  !
contains
  function ibase(ival)
    !-------------------------------------------------------------------
    ! Return index in base arrray for ival-th of histogram
    !-------------------------------------------------------------------
    integer(kind=size_length) :: ibase
    integer(kind=size_length), intent(in) :: ival
    if (nbase.eq.nxy) then
      ibase = ival
    else
      ibase = 1
    endif
  end function ibase
end subroutine gr8_yxhisto_base
!
subroutine gr8_histo_hatchfill(nxy,x,y,nbase,base,bval,eval,drawing,error)
  use gildas_def
  use greg_interfaces, except_this=>gr8_histo_hatchfill
  use greg_types
  !---------------------------------------------------------------------
  ! @ public-mandatory
  !  Build the histogram from the input X and Y values, and fill it
  ! with hatches and maybe color. Contour is not drawn.
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: nxy          ! Number of points
  real(kind=8),              intent(in)    :: x(nxy)       ! Array of X coordinates
  real(kind=8),              intent(in)    :: y(nxy)       ! Array of Y coordinates
  integer(kind=size_length), intent(in)    :: nbase        ! Number base points (1 or Nxy)
  real(kind=8),              intent(in)    :: base(nbase)  ! Base of histogram
  real(kind=8),              intent(in)    :: bval         ! Blanking value
  real(kind=8),              intent(in)    :: eval         ! Tolerance on blanking value
  type(polygon_drawing_t),   intent(in)    :: drawing      ! Drawing description
  logical,                   intent(inout) :: error        ! Logical error flag
  ! Local
  real(kind=8), allocatable :: x2(:),y2(:)
  real(kind=8) :: xav
  integer(kind=size_length) :: j,istart,nelem,inext,jbase,npts
  !
  if (nxy.lt.2) return
  !
  inext = 1
  do while (inext.ne.0)
    ! Read data by blocks of valid values (non blanks if eval>=0, and non NaNs)
    call find_blank8(y,bval,eval,nxy,istart,nelem,inext)
    if (nelem.le.0)  cycle
    !
    ! 1) Build the polygon histogram from the valid values
    npts = 0
    if (istart.eq.1) then
      xav = x(1) - 0.5d0*(x(2)-x(1))
    else
      xav = 0.5d0 * (x(istart-1)+x(istart))
    endif
    call new_point(xav,base(ibase(istart)))  ! First point
    call new_point(xav,y(istart))
    !
    ! Histogram top (left parts)
    do j=2,nelem
      xav = 0.5d0 * (x(istart+j-2)+x(istart+j-1))
      call new_point(xav,y(istart+j-2))
      call new_point(xav,y(istart+j-1))
    enddo
    ! Histogram top (right part)
    if (istart+nelem-1.eq.nxy) then
      xav = x(nxy) + 0.5d0*(x(nxy)-x(nxy-1))
    else
      xav = 0.5d0 * (x(istart+nelem-1)+x(istart+nelem))
    endif
    call new_point(xav,y(istart+nelem-1))
    !
    ! Base
    call new_point(xav,base(ibase(istart+nelem-1)))
    if (nbase.eq.nxy) then
      ! 1D base array
      do jbase=istart+nelem-1,istart+1,-1
        xav = 0.5d0 * (x(jbase-1)+x(jbase))
        call new_point(xav,base(ibase(jbase)))
        call new_point(xav,base(ibase(jbase-1)))
      enddo
    endif
    !
    ! Close the polygon
    call last_point()
    !
    ! 2) Drawings
    ! Contour:
    ! call gr8_connect(nxy2,x2,y2,bval,eval)
    !
    if (drawing%filled) then
      ! Fill the region
      call gr8_ufill(npts,x2,y2)
    endif
    !
    if (drawing%hatched) then
      ! Hatch the region
      call gr8_hatch('HISTO',npts,x2,y2,  &
                    drawing%hangle,drawing%hsepar,drawing%hphase,error)
      if (error)  return
    endif
    !
  enddo
  !
contains
  function ibase(ival)
    !-------------------------------------------------------------------
    ! Return index in base arrray for ival-th of histogram
    !-------------------------------------------------------------------
    integer(kind=size_length) :: ibase
    integer(kind=size_length), intent(in) :: ival
    if (nbase.eq.nxy) then
      ibase = ival
    else
      ibase = 1
    endif
  end function ibase
  !
  subroutine new_point(xx,yy)
    real(kind=8), intent(in) :: xx,yy
    npts = npts+1
    call reallocate_x2y2(npts)
    x2(npts) = xx
    y2(npts) = yy
  end subroutine new_point
  !
  subroutine last_point()
    npts = npts+1
    call reallocate_x2y2(npts)
    x2(npts) = x2(1)
    y2(npts) = y2(1)
  end subroutine last_point
  !
  subroutine reallocate_x2y2(nn)
    integer(kind=size_length), intent(in) :: nn
    integer(kind=size_length), parameter :: minalloc=100
    integer(kind=size_length) :: osize,nsize
    real(kind=8), allocatable :: xtmp(:),ytmp(:)
    nsize = max(nn,minalloc)
    if (allocated(x2)) then
      osize = size(x2)
      if (osize.ge.nn)  return  ! Resize not needed
      call move_alloc(from=x2,to=xtmp)
      call move_alloc(from=y2,to=ytmp)
      nsize = max(nsize,2*osize)
    endif
    allocate(x2(nsize),y2(nsize))
    if (allocated(xtmp)) then
      x2(1:osize) = xtmp(1:osize)
      y2(1:osize) = ytmp(1:osize)
      deallocate(xtmp,ytmp)
    endif
  end subroutine reallocate_x2y2
  !
end subroutine gr8_histo_hatchfill
!
subroutine gr8_yxhisto_hatchfill(nxy,x,y,nbase,base,bval,eval,drawing,error)
  use gildas_def
  use greg_interfaces, except_this=>gr8_yxhisto_hatchfill
  use greg_types
  !---------------------------------------------------------------------
  ! @ public-mandatory
  !  Same as gr8_histo_hatchfill, but binning is along Y, and X provides
  ! the counts per bin. Bval/Eval apply on X.
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: nxy          ! Number of points
  real(kind=8),              intent(in)    :: x(nxy)       ! Array of X coordinates
  real(kind=8),              intent(in)    :: y(nxy)       ! Array of Y coordinates
  integer(kind=size_length), intent(in)    :: nbase        ! Number base points (1 or Nxy)
  real(kind=8),              intent(in)    :: base(nbase)  ! Base of histogram
  real(kind=8),              intent(in)    :: bval         ! Blanking value
  real(kind=8),              intent(in)    :: eval         ! Tolerance on blanking value
  type(polygon_drawing_t),   intent(in)    :: drawing      ! Drawing description
  logical,                   intent(inout) :: error        ! Logical error flag
  ! Local
  real(kind=8), allocatable :: x2(:),y2(:)
  real(kind=8) :: yav
  integer(kind=size_length) :: j,istart,nelem,inext,jbase,npts
  !
  if (nxy.lt.2) return
  !
  inext = 1
  do while (inext.ne.0)
    ! Read data by blocks of valid values (non blanks if eval>=0, and non NaNs)
    call find_blank8(x,bval,eval,nxy,istart,nelem,inext)
    if (nelem.le.0)  cycle
    !
    ! 1) Build the polygon histogram from the valid values
    npts = 0
    if (istart.eq.1) then
      yav = y(1) - 0.5d0*(y(2)-y(1))
    else
      yav = 0.5d0 * (y(istart-1)+y(istart))
    endif
    call new_point(base(ibase(istart)),yav)  ! First point
    call new_point(x(istart),yav)
    !
    ! Histogram top (left parts)
    do j=2,nelem
      yav = 0.5d0 * (y(istart+j-2)+y(istart+j-1))
      call new_point(x(istart+j-2),yav)
      call new_point(x(istart+j-1),yav)
    enddo
    ! Histogram top (right part)
    if (istart+nelem-1.eq.nxy) then
      yav = y(nxy) + 0.5d0*(y(nxy)-y(nxy-1))
    else
      yav = 0.5d0 * (y(istart+nelem-1)+y(istart+nelem))
    endif
    call new_point(x(istart+nelem-1),yav)
    !
    ! Base
    call new_point(base(ibase(istart+nelem-1)),yav)
    if (nbase.eq.nxy) then
      do jbase=istart+nelem-1,istart+1,-1
        yav = 0.5d0 * (y(jbase-1)+y(jbase))
        call new_point(base(ibase(jbase)),yav)
        call new_point(base(ibase(jbase-1)),yav)
      enddo
    endif
    !
    ! Close the polygon
    call last_point()
    !
    ! 2) Drawings
    ! Contour:
    ! call gr8_connect(nxy2,x2,y2,bval,eval)
    !
    if (drawing%filled) then
      ! Fill the region
      call gr8_ufill(npts,x2,y2)
    endif
    !
    if (drawing%hatched) then
      ! Hatch the region
      call gr8_hatch('HISTO',npts,x2,y2,  &
                    drawing%hangle,drawing%hsepar,drawing%hphase,error)
      if (error)  return
    endif
    !
  enddo
  !
contains
  function ibase(ival)
    !-------------------------------------------------------------------
    ! Return index in base arrray for ival-th of histogram
    !-------------------------------------------------------------------
    integer(kind=size_length) :: ibase
    integer(kind=size_length), intent(in) :: ival
    if (nbase.eq.nxy) then
      ibase = ival
    else
      ibase = 1
    endif
  end function ibase
  !
  subroutine new_point(xx,yy)
    real(kind=8), intent(in) :: xx,yy
    npts = npts+1
    call reallocate_x2y2(npts)
    x2(npts) = xx
    y2(npts) = yy
  end subroutine new_point
  !
  subroutine last_point()
    npts = npts+1
    call reallocate_x2y2(npts)
    x2(npts) = x2(1)
    y2(npts) = y2(1)
  end subroutine last_point
  !
  subroutine reallocate_x2y2(nn)
    integer(kind=size_length), intent(in) :: nn
    integer(kind=size_length), parameter :: minalloc=100
    integer(kind=size_length) :: osize,nsize
    real(kind=8), allocatable :: xtmp(:),ytmp(:)
    nsize = max(nn,minalloc)
    if (allocated(x2)) then
      osize = size(x2)
      if (osize.ge.nn)  return  ! Resize not needed
      call move_alloc(from=x2,to=xtmp)
      call move_alloc(from=y2,to=ytmp)
      nsize = max(nsize,2*osize)
    endif
    allocate(x2(nsize),y2(nsize))
    if (allocated(xtmp)) then
      x2(1:osize) = xtmp(1:osize)
      y2(1:osize) = ytmp(1:osize)
      deallocate(xtmp,ytmp)
    endif
  end subroutine reallocate_x2y2
  !
end subroutine gr8_yxhisto_hatchfill
