subroutine gtv_image(nx,ny,data,location,limits,convert,scaling,cuts,extrema,  &
  blank,is_visible,is_curima,error)
  use gbl_message
  use gtv_bitmap
  use gtv_buffers
  use gtv_interfaces, except_this=>gtv_image
  use gtv_plot
  !---------------------------------------------------------------------
  ! @ public-mandatory (because symbol is used elsewhere)
  !  Allocate a new GTVIRT image slot. Image numbers may not be
  ! continuous, search for one from start.
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: nx   ! Image size in X
  integer(kind=index_length), intent(in) :: ny   ! Image size in Y
  real(kind=4),    intent(in)    :: data(nx,ny)  ! Image values
  real(kind=4),    intent(in)    :: location(4)  ! Position in Paper coordinates
  real(kind=4),    intent(in)    :: limits(4)    ! User limits
  real(kind=4),    intent(in)    :: convert(6)   ! Image pixel to User conversion formula
  integer(kind=4), intent(in)    :: scaling      ! Scaling mode (1=Lin, 2=Log, 3=Equ)
  real(kind=4),    intent(in)    :: cuts(2)      ! Low and High cut
  real(kind=4),    intent(in)    :: extrema(2)   ! Low and High extrema
  real(kind=4),    intent(in)    :: blank(3)     ! Blanking value
  logical,         intent(in)    :: is_visible   ! Always Visible ?
  logical,         intent(in)    :: is_curima    ! Update the SIC structure CURIMA% ?
  logical,         intent(inout) :: error        ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='PLOT'
  integer(kind=4) :: ier
  real(kind=4) :: rmin,rmax
  type(gt_image), pointer :: image
  character(len=message_length) :: mess
  !
  ! Allocate a new gt_image instance
  allocate(image,stat=ier)
  if (ier.ne.0) then
    call gtv_message(seve%e,rname,'Error allocating a new image')
    error = .true.
    return
  endif
  image%isrgb = .false.
  image%scaling = scaling
  image%lut => null()
  image%r%values => null()
  image%g%values => null()
  image%b%values => null()
  image%next => null()
  nb_image = nb_image+1
  !
  ! Set up the linked list
  if (associated(image_first)) then
    image_last%next => image
  else
    image_first => image
  endif
  image_last => image
  !
  ! Do we need to save the current LUT in the metacode before starting
  ! to write the image?
  if (lut_static) then
    if (.not.associated(co_segment%head%lut)) then
      ! We have to save to current global LUT in the metacode
      call gt_lut_segdata(error)  ! This sets co_segment%head%lut
      if (error)  return
    endif
  endif
  !
  ! LUT
  image%lut => co_segment%head%lut  ! Which can be null()
  !
  ! NB: freeing 1 image slot is done by 'gtv_delimage'. Freeing ALL slots
  ! at once and resetting 'max_image_num' and 'nb_image' can not be done,
  ! since 'gtv_delimage' is put in the stack and we can not predict when
  ! it will be executed. This is not a problem since the image slot
  ! allocation/deallocation has no memory leak as long as the stack does
  ! its job regularly.
  !
  image%r%taille(1) = nx
  image%r%taille(2) = ny
  !
  ! Allocate virtual memory
  allocate(image%r%values(nx,ny),stat=ier)
  if (ier.ne.0) then
    ! error = .true.
    return
  endif
  !
  ! Copy the data
  image%r%values = data
  !
  image%r%blank = blank
  image%r%cuts = cuts
  image%r%extrema = extrema
  !
  if (cdepth.le.1)  cdepth = 2
  !
  select case (image%scaling)
  case (scale_equ)
    ! Compute the scaled image if scaling is EQUALIZATION
    call gtv_image_equalize(image%r,error)
    if (error)  return
  case (scale_log)
    ! Recompute the cuts for better ones if they are invalid
    if (any(cuts.le.0.)) then
      ! Patch (only) the invalid cut(s)
      call gtv_image_logcuts(data,nx*ny,blank(1:2),rmin,rmax)
      if (cuts(1).lt.cuts(2)) then
        if (cuts(1).lt.0.)  image%r%cuts(1) = rmin
        if (cuts(2).lt.0.)  image%r%cuts(2) = rmax
      else
        if (cuts(2).lt.0.)  image%r%cuts(2) = rmin
        if (cuts(1).lt.0.)  image%r%cuts(1) = rmax
      endif
      write(mess,'(3(A,1PG14.7))')  'Low and high cuts forced to ',  &
        image%r%cuts(1),' and ',image%r%cuts(2),' for logarithmic scaling'
      call gtv_message(seve%w,rname,mess)
    endif
  end select
  !
  ! Setup the remaining elements and attach the gt_image in the tree
  call gtv_image_segdata(image,location,limits,convert,is_visible,error)
  if (error)  return
  !
  if (is_curima) then
    call gtv_image_variables(image,.false.,error)
    if (error)  return
  endif
  !
end subroutine gtv_image
!
subroutine gtv_rgbimage(nx,ny,    &
    rdata,rblank,rcuts,rextrema,  &
    gdata,gblank,gcuts,gextrema,  &
    bdata,bblank,bcuts,bextrema,  &
    scaling,scaling_lup_b,        &
    location,limits,convert,is_visible,error)
  use gbl_message
  use gtv_bitmap
  use gtv_buffers
  use gtv_interfaces, except_this=>gtv_rgbimage
  use gtv_plot
  !---------------------------------------------------------------------
  ! @ public-mandatory (because symbol is used elsewhere)
  !  Allocate a new GTVIRT image slot. Image numbers may not be
  ! continuous, search for one from start.
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: nx         ! RGB image size in X
  integer(kind=index_length), intent(in) :: ny         ! RGB image size in Y
  real(kind=4),    intent(in)    :: rdata(nx,ny)       ! R image values
  real(kind=4),    intent(in)    :: rblank(3)          ! R blanking value
  real(kind=4),    intent(in)    :: rcuts(2)           ! R low and high cut
  real(kind=4),    intent(in)    :: rextrema(2)        ! R low and high extrema
  real(kind=4),    intent(in)    :: gdata(nx,ny)       ! G image values
  real(kind=4),    intent(in)    :: gblank(3)          ! G blanking value
  real(kind=4),    intent(in)    :: gcuts(2)           ! G low and high cut
  real(kind=4),    intent(in)    :: gextrema(2)        ! G low and high extrema
  real(kind=4),    intent(in)    :: bdata(nx,ny)       ! B image values
  real(kind=4),    intent(in)    :: bblank(3)          ! B blanking value
  real(kind=4),    intent(in)    :: bcuts(2)           ! B low and high cut
  real(kind=4),    intent(in)    :: bextrema(2)        ! B low and ligh extrema
  integer(kind=4), intent(in)    :: scaling            ! RGB scaling mode
  real(kind=4),    intent(in)    :: scaling_lup_b      ! Beta parameter for Lupton scaling mode
  real(kind=4),    intent(in)    :: location(4)        ! Position in Paper coordinates
  real(kind=4),    intent(in)    :: limits(4)          ! User limits
  real(kind=4),    intent(in)    :: convert(6)         ! Image pixel to User conversion formula
  logical,         intent(in)    :: is_visible         ! Always Visible ?
  logical,         intent(inout) :: error              ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='RGB_IMAGE'
  integer :: ier
  type(gt_image), pointer :: rgb
  !
  ! Allocate a new gt_rgb instance
  allocate(rgb,stat=ier)
  if (ier.ne.0) then
    call gtv_message(seve%e,rname,'Error allocating a new RGB image')
    error = .true.
    return
  endif
  rgb%isrgb = .true.
  rgb%scaling = scaling
  rgb%scaling_lup_b = scaling_lup_b
  rgb%lut => null()
  rgb%r%values => null()
  rgb%g%values => null()
  rgb%b%values => null()
  rgb%next => null()
  nb_image = nb_image+1
  !
  ! Set up the linked list
  if (associated(image_first)) then
    image_last%next => rgb
  else
    image_first => rgb
  endif
  image_last => rgb
  !
  ! NB: freeing 1 image slot is done by 'gtv_delimage'. Freeing ALL slots
  ! at once and resetting 'max_image_num' and 'nb_image' can not be done,
  ! since 'gtv_delimage' is put in the stack and we can not predict when
  ! it will be executed. This is not a problem since the image slot
  ! allocation/deallocation has no memory leak as long as the stack does
  ! its job regularly.
  !
  rgb%r%taille(1) = nx
  rgb%r%taille(2) = ny
  rgb%g%taille(1) = nx
  rgb%g%taille(2) = ny
  rgb%b%taille(1) = nx
  rgb%b%taille(2) = ny
  !
  ! Allocate virtual memory
  allocate(rgb%r%values(nx,ny),rgb%g%values(nx,ny),rgb%b%values(nx,ny),stat=ier)
  if (ier.ne.0) then
    ! error = .true.
    return
  endif
  !
  ! Copy the data
  rgb%r%values = rdata
  rgb%r%blank = rblank
  rgb%r%cuts = rcuts
  rgb%r%extrema = rextrema
  !
  rgb%g%values = gdata
  rgb%g%blank = gblank
  rgb%g%cuts = gcuts
  rgb%g%extrema = gextrema
  !
  rgb%b%values = bdata
  rgb%b%blank = bblank
  rgb%b%cuts = bcuts
  rgb%b%extrema = bextrema
  !
  if (cdepth.le.1)  cdepth = 2
  !
  ! Compute the scaled image if scaling is EQUALIZATION
  if (rgb%scaling.eq.scale_equ) then
    call gtv_image_equalize(rgb%r,error)
    if (error)  return
    call gtv_image_equalize(rgb%g,error)
    if (error)  return
    call gtv_image_equalize(rgb%b,error)
    if (error)  return
  endif
  !
  ! Setup the remaining elements and attach the gt_image in the tree
  call gtv_image_segdata(rgb,location,limits,convert,is_visible,error)
  if (error)  return
  !
end subroutine gtv_rgbimage
!
subroutine gtv_image_segdata(ima,location,limits,convert,is_visible,error)
  use gtv_bitmap
  use gtv_buffers
  use gtv_graphic
  use gtv_interfaces, except_this=>gtv_image_segdata
  use gtv_plot
  use gtv_segatt
  use gtv_tree
  use gtv_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !   Stores the image descriptor in the metacode, in the currently
  ! opened segment.
  ! ---
  !   Threads status: thread safe
  !---------------------------------------------------------------------
  type(gt_image),  target        :: ima          ! Image instance
  real(kind=4),    intent(in)    :: location(4)  ! Position in Paper coordinates
  real(kind=4),    intent(in)    :: limits(4)    ! User limits
  real(kind=4),    intent(in)    :: convert(6)   ! Image pixel to User conversion formula
  logical,         intent(in)    :: is_visible   ! Always Visible ?
  logical,         intent(inout) :: error        ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='GTV_IMAGE'
  integer(kind=4) :: ier
  !
  call gtv_open_segments_for_writing_from_main()
  !
  ! Segment descriptor is created. Let's update the image location
  co_segment%head%gen%minmax(1) = location(1)  ! xmin
  co_segment%head%gen%minmax(2) = location(2)  ! xmax
  co_segment%head%gen%minmax(3) = location(3)  ! ymin
  co_segment%head%gen%minmax(4) = location(4)  ! ymax
  ! Update the extrema of the parent directory
  call dir_extrema(co_segment%father,co_segment%head%gen%minmax)
  !
  if (.not.associated(co_segment_data)) then
    allocate(co_segment%data,stat=ier)
    if (ier.ne.0) then
      call gtv_message(seve%e,rname,'Internal error: allocation failure (1)')
      error = .true.
      goto 10
    endif
    co_segment_data => co_segment%data
  else
    allocate(co_segment_data%nextdata,stat=ier)
    if (ier.ne.0) then
      call gtv_message(seve%e,rname,'Internal error: allocation failure (2)')
      error = .true.
      goto 10
    endif
    co_segment_data => co_segment_data%nextdata
  endif
  co_segment_data%nextdata => null()
  co_segment_data%kind = seg_image
  co_segment_data%image => ima
  !
  ! Image Position in Page
  ima%position = location
  ! Box User coordinates
  ima%limits = limits
  ! Pixel to User conversion
  ima%conv = convert
  !
  co_segment%head%attr%depth = cdepth
  vdepth(cdepth) = .true.
  !
10 continue
  !
  call gtv_close_segments_for_writing_from_main()
  !
end subroutine gtv_image_segdata
!
subroutine gtv_delimage(image)
  use gtv_bitmap
  use gtv_interfaces, except_this=>gtv_delimage
  use gtv_protocol
  !---------------------------------------------------------------------
  ! @ private
  !   Delete a GTVIRT image structure.
  !---------------------------------------------------------------------
  type(gt_image), target :: image  ! Image slot to free
  ! Local
  type(gt_image), pointer :: image_p,curima,previma
  integer :: iout
  type(gt_bitmap), pointer :: xbitmap,prevbit
  !
  ! Update the linked list
  previma => null()
  curima => image_first
  do while (.not.associated(curima,image))
    previma => curima
    curima => curima%next
  enddo
  !
  if (.not.associated(previma)) then
    image_first => curima%next  ! ... which can be null()
  else
    previma%next => curima%next  ! ... which can be null()
  endif
  if (associated(image_last,image)) then
    image_last => previma  ! ... which can be null()
  endif
  !
  ! Original
  if (associated(image%r%values))   deallocate(image%r%values)
  if (associated(image%g%values))   deallocate(image%g%values)
  if (associated(image%b%values))   deallocate(image%b%values)
  if (allocated(image%r%eqvalues))  deallocate(image%r%eqvalues)
  if (allocated(image%g%eqvalues))  deallocate(image%g%eqvalues)
  if (allocated(image%b%eqvalues))  deallocate(image%b%eqvalues)
  !
  ! Resampled
  do iout=1,moutputs
    prevbit => null()
    xbitmap => all_outputs(iout)%x%bitmap_first
    do while (associated(xbitmap))
      !
      if (associated(xbitmap%image,image)) then
        ! Take care of the chain first
        if (.not.associated(prevbit)) then
          all_outputs(iout)%x%bitmap_first => xbitmap%next  ! ... which can be null()
        else
          prevbit%next => xbitmap%next  ! ... which can be null()
        endif
        if (associated(all_outputs(iout)%x%bitmap_last,xbitmap)) then
          all_outputs(iout)%x%bitmap_last => prevbit   ! ... which can be null()
        endif
        !
        call gt_bitmap_deallocate(xbitmap)
        !
        exit  ! Jump to next window
      endif
      !
      prevbit => xbitmap
      xbitmap => xbitmap%next
    enddo
  enddo
  !
  ! Deallocate the instance
  image_p => image
  deallocate(image_p)
  !
  nb_image = nb_image-1
  !
end subroutine gtv_delimage
!
subroutine gtv_image_variables(ima,update,error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gtv_image_variables
  use gbl_message
  use gtv_bitmap
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Update or define the SIC structure CURIMA% according to the input
  ! image instance
  !---------------------------------------------------------------------
  type(gt_image), pointer       :: ima     ! Image instance
  logical,        intent(in)    :: update  ! Update or define?
  logical,        intent(inout) :: error   ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='GTV_IMAGE'
  character(len=varname_length) :: varname
  ! Support variables
  type(gt_image), pointer, save :: curima
  integer(kind=4),         save :: curima_scaling
  real(kind=4),            save :: curima_scale(2)
  logical, save :: first_time
  ! Data
  data first_time /.true./
  !
  ! Nothing to do if we only want to update the image scaling, but input
  ! is not the one referenced by CURIMA%
  if (update) then
    if (.not.associated(ima,curima))  return
  endif
  !
  if (.not.associated(ima%r%values)) then
    call gtv_message(seve%e,rname,'Programming error: no such image')
    error = .true.
    return
  endif
  !
  if (first_time) then
    call sic_defstructure('CURIMA',.true.,error)
    !
    call sic_def_inte('CURIMA%SCALING',curima_scaling,0,0,.true.,error)
    call sic_def_real('CURIMA%SCALE',  curima_scale,  1,2,.true.,error)
    if (error)  return
    !
    first_time = .false.
  endif
  !
  curima => ima
  curima_scaling = ima%scaling
  curima_scale   = ima%r%cuts
  !
  ! Equalization levels
  varname = 'CURIMA%EQUAL%NLEV'
  !
  if (sic_varexist(varname)) then
    call sic_delvariable('CURIMA%EQUAL%NLEV',.false.,error)
    call sic_delvariable('CURIMA%EQUAL%LEV',.false.,error)
    call sic_delvariable('CURIMA%EQUAL%HIST',.false.,error)
    if (error)  return
  endif
  !
  if (ima%scaling.eq.scale_equ) then
    call sic_def_inte('CURIMA%EQUAL%NLEV',eqnlev,0,     1,.true.,error)
    call sic_def_real('CURIMA%EQUAL%LEV', eqlev, 1,eqnlev,.true.,error)
#if defined(BITS64)
    call sic_def_long('CURIMA%EQUAL%HIST',eqbin, 1,eqnlev,.true.,error)
#else
    call sic_def_inte('CURIMA%EQUAL%HIST',eqbin, 1,eqnlev,.true.,error)
#endif
    if (error)  return
  endif
  !
end subroutine gtv_image_variables
!
subroutine gtv_image_logcuts(data,nxy,blank,rmin,rmax)
  use gildas_def
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Compute the best extrema suited for LOG scaling
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)   :: nxy
  real(kind=4),              intent(in)   :: data(nxy)
  real(kind=4),              intent(in)   :: blank(2)
  real(kind=4),              intent(out)  :: rmin,rmax
  ! Local
  character(len=*), parameter :: rname='PLOT'
  integer(kind=size_length) :: ixy,first
  !
  ! First valid value
  first = 0
  do ixy=1,nxy
    if (abs(data(ixy)-blank(1)).le.blank(2))  cycle
    if (data(ixy).le.0.)  cycle
    first = ixy
    exit
  enddo
  if (first.eq.0) then
    call gtv_message(seve%w,rname,'No positive data found')
    rmin = 1.0
    rmax = 10.0
    return
  endif
  !
  ! Min value
  rmin = data(first)
  do ixy=first+1,nxy
    if (abs(data(ixy)-blank(1)).le.blank(2))  cycle
    if (data(ixy).le.0.)  cycle
    if (rmin.gt.data(ixy))  rmin = data(ixy)
  enddo
  !
  ! Max value
  rmax = data(first)
  do ixy=first+1,nxy
    if (abs(data(ixy)-blank(1)).le.blank(2))  cycle
    if (data(ixy).le.0.)  cycle
    if (rmax.lt.data(ixy))  rmax = data(ixy)
  enddo
  !
end subroutine gtv_image_logcuts
!
subroutine gtv_image_equalize(data,error)
  use gbl_message
  use gtv_interfaces, except_this=>gtv_image_equalize
  use gtv_plot
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Compute the scaled image if scaling is EQUALIZATION
  !---------------------------------------------------------------------
  type(gt_image_data), intent(inout) :: data   !
  logical,             intent(inout) :: error  !
  ! Local
  integer :: ier
  !
  if (.not.allocated(data%eqvalues)) then
    allocate(data%eqvalues(data%taille(1),data%taille(2)),stat=ier)
    if (ier.ne.0) then
      call gtv_message(seve%e,'EQUAL','Internal error: allocation failure')
      error = .true.
      return
    endif
  endif
  !
  call gt_image_equalize(data%values,                    &
                         data%eqvalues,                  &
                         data%taille(1),data%taille(2),  &
                         lut_size,                       &
                         data%cuts(1),data%cuts(2),      &
                         data%blank(1),data%blank(2),    &
                         error)
  if (error) then
    deallocate(data%eqvalues)
    return
  endif
  !
end subroutine gtv_image_equalize
!
subroutine gt_image_equalize(imagein,eqimage,nx,ny,ncol,rmin,rmax,  &
  bval,eval,error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gt_image_equalize
  use gbl_message
  use gtv_bitmap
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  real(kind=4),                 intent(in)    :: imagein(*)  ! Original image
  integer(kind=2*bitmap_depth), intent(inout) :: eqimage(*)  ! Scaled values
  integer(kind=index_length),   intent(in)    :: nx,ny       ! Size of image
  integer(kind=4),              intent(in)    :: ncol        ! Number of colours
  real(kind=4),                 intent(in)    :: rmin,rmax   ! Range
  real(kind=4),                 intent(in)    :: bval,eval   ! Blanking value
  logical,                      intent(inout) :: error       ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='EQUAL'
  real(kind=4), allocatable :: image(:)
  integer(kind=4), allocatable :: ist(:)
  integer(kind=2*bitmap_depth) :: entier
  integer :: ier
  !
  ! Device dependent. Version for 8-bit bitmap
  integer(kind=bitmap_depth) :: bitmap
#if defined(VAX) || defined(IEEE)
  equivalence (entier,bitmap)
#endif
#if defined(EEEI)
  integer(kind=bitmap_depth) bitarr(2)
  equivalence (entier,bitarr(1)),(bitarr(2),bitmap)
#endif
  logical :: doblank,hasblank
  integer :: level
  integer(kind=size_length) :: nduplicate,ngood,ipix,npixels,nblank,nreal,n
  real(kind=4) :: last_value,value,locbval,kase,iquota,color,colorinc
  !
  npixels = nx*ny
  !
  ! In order to save the contents of 'image', we need to work on a copy
  allocate(image(npixels),ist(npixels),stat=ier)
  if (ier.ne.0) then
    call gtv_message(seve%e,rname,  &
      'Allocation failure during equalization scaling')
    return
  endif
  !
  ! Copy
  doblank = eval.ge.0.
  hasblank = .false.
  locbval = rmax+1.  ! Reject blank values out of the [rmin--rmax] real values
  do ipix=1,npixels
    value = imagein(ipix)
    if (value.ne.value) then
      ! Patch for NaN
      hasblank = .true.
      image(ipix) = locbval
    elseif (doblank .and. abs(value-bval).le.eval) then
      hasblank = .true.
      image(ipix) = locbval
    elseif (value.le.rmin) then
      image(ipix) = rmin
    elseif (value.ge.rmax) then
      image(ipix) = rmax
    else
      image(ipix) = value
    endif
  enddo
  !
  ! Sort array
  call gr4_trie(image,ist,int(npixels,kind=4),error)
  if (error) then
    call gtv_message(seve%e,rname,'Error during pixel sorting')
    eqnlev=0
    return
  endif
  ! Now image is sorted and IST contains original offset
  !
  if (hasblank) then
    call gr4_dicho(npixels,image,locbval,nreal)  ! Returns index of first blank value
    nreal = nreal-1  ! Last real (i.e. non-blank) value
    nblank = npixels-nreal
  else
    nreal = npixels
    nblank = 0
  endif
  !
  ! Search for the number of real and non-duplicate values
  nduplicate = 0
  last_value = image(1)
  do ipix = 2,nreal
    value = image(ipix)
    if (value.eq.last_value) then
      nduplicate = nduplicate+1
    else
      last_value = value
    endif
  enddo
  !
  ngood = nreal-nduplicate
  if (ngood.ge.ncol) then
    iquota = float(ngood)/float(ncol)
    colorinc = 1.
  elseif (ngood.ne.0) then
    ! There is more colors than values
    iquota = 1.
    colorinc = float(ncol-1)/float(ngood)
  else
    ! No good value (all are blanked). Set dummy values
    iquota = 1.
    colorinc = 0.
  endif
  !
  ! Most images are from poorly digitized pixels. Often the number of different
  ! values is smaller than NCOL. This is not an EQUALIZATION mode, so we warn
  ! the user. To compensate for the small number of levels, we will start from
  ! the upper end of values when scaling to integers, so as to saturate the image
  !      IF (IQUOTA.LE.0.OR.IGOOD.LE.0.1*(IHAUT-IBAS+1)) THEN
  !         WRITE(CHAIN,'(A,I6,A)')
  !     &   'W-EQUAL,  Poorly digitized image: only ',IGOOD,
  !     &   ' DIFFERENT values in image.'
  !         CALL GAGOUT(CHAIN)
  !         WRITE(CHAIN,'(A,A)')
  !     &   '          Please inspect Histogram stored in variables',
  !     &   ' CURIMA%EQUAL%LEV and CURIMA%EQUAL%HIST'
  !         CALL GAGOUT(CHAIN)
  !      ENDIF
  !
  ! Compute values of the array EQLEV (impossible to do otherwise since we
  ! erase quasi-randomly IMAGE when rescaling on integer values). We keep the
  ! "breakpoints" in array EQBIN:
  !
  if (.not.allocated(eqlev)) then
    allocate(eqlev(bitmap_dynamic_max),eqbin(bitmap_dynamic_max),stat=ier)
    if (ier.ne.0) then
      call gtv_message(seve%e,rname,  &
        'Internal error: failed to allocate equalization support variables')
      error = .true.
      return
    endif
  endif
  !
  if (ngood.gt.0) then
    last_value = image(1)
    level = 1
    eqnlev = 1
    eqlev(eqnlev) = last_value
    eqbin(eqnlev) = 1
    kase = 0.
    do n = 2,nreal
      value = image(n)
      if (value.ne.last_value) then
        last_value=value
        kase = kase+1.
      endif
      if (kase.ge.iquota) then
        level = level+1
        eqnlev = level
        eqlev(eqnlev) = value
        eqbin(eqnlev) = n
        kase = mod(kase,iquota)
      endif
    enddo
  else
    eqnlev = 0
  endif
  !
  ! Replaces the sorted IMAGE by a restricted range of integer values
  !
  ! KASE Compteur des pixels attribues a une kase de l'histogramme
  ! VALUE and LAST_VALUE: Check that we do no change color between two
  ! pixels having the same value . The program is now (?) protected against
  ! huge amounts of pixels having the same value.
  !
  level = 1
  color = 1.
  if (eqnlev.gt.1) then
    do ipix = 1,eqbin(eqnlev)-1
      if (ipix.ge.eqbin(level+1)) then
        level = level+1
        color = color+colorinc
      endif
      eqimage(ist(ipix)) = nint(color)
    enddo
    ! Last bin of real values
    color = color+colorinc
    do ipix = eqbin(eqnlev),nreal
      eqimage(ist(ipix)) = nint(color)
    enddo
  else
    ! Only 1 (or even 0, i.e. nreal==0) bin
    do ipix = 1,nreal
      eqimage(ist(ipix)) = nint(color)
    enddo
  endif
  ! Blanked bin
  if (hasblank) then
    do ipix=nreal+1,npixels
      eqimage(ist(ipix)) = ncol+1
    enddo
  endif
  !
  deallocate(image,ist)
  !
end subroutine gt_image_equalize
!
!-----------------------------------------------------------------------
! Beyond this point: generic routines traversing the tree searching
! for images.
!-----------------------------------------------------------------------
recursive subroutine exec_images_recurs(dir,execop)
  use gtv_buffers
  use gtv_interfaces, except_this=>exec_images_recurs
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Traverse all the leaves of the input directory and recursively in
  ! subdirectories and execute the input routine 'execop' on the GTV
  ! images it finds.
  !---------------------------------------------------------------------
  type(gt_directory) :: dir     ! Starting directory
  external           :: execop  !
  ! Local
  type(gt_segment), pointer :: leaf
  type(gt_directory), pointer :: son
  !
  ! 1) Search for all the leaves
  leaf => dir%leaf_first
  do while (associated(leaf))
    call image_codeop(leaf,execop)
    leaf => leaf%nextseg
  enddo
  !
  ! 2) Loop on all the subdirectories
  son => dir%son_first
  do while (associated(son))
    call exec_images_recurs(son,execop)
    son => son%brother
  enddo
  !
end subroutine exec_images_recurs
!
subroutine image_codeop(leaf,execop)
  use gtv_interfaces, except_this=>image_codeop
  use gtv_buffers
  use gtv_plot
  use gtv_tree
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Generic entry point which reads the input 'leaf' and execute
  ! the input routine if it finds a the GTV image (and only a GTV
  ! image).
  !  'execop' takes the image address as unique argument
  !---------------------------------------------------------------------
  type(gt_segment), pointer :: leaf    ! Segment instance
  external                  :: execop  ! Routine to execute on the image
  ! Local
  type(gt_segment_data), pointer :: segdata
  logical :: error
  !
  if (lut_static) then
    ! Save the current global LUT as last data in this segment
    co_segment => leaf
    co_segment_data => null()
    segdata => leaf%data
    do while (associated(segdata))
      co_segment_data => segdata
      segdata => segdata%nextdata
    enddo
    error= .false.
    call gt_lut_segdata(error)
    co_segment => null()
    co_segment_data => null()
  else
    ! Unset the LUT to be used by the polylines. We should also remove its
    ! data (which is somewhere in the linked list of data)
    leaf%head%lut => null()
  endif
  !
  ! Follow the linked list of data
  segdata => leaf%data
  do while (associated(segdata))
    if (segdata%kind.eq.seg_image)  call execop(leaf%head,segdata%image)
    !
    segdata => segdata%nextdata
  enddo
  !
end subroutine image_codeop
