subroutine init_lut(error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>init_lut
  use gtv_protocol
  use gtv_plot
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !   Initialize a look-up-table for colours
  !---------------------------------------------------------------------
  logical, intent(inout) :: error
  ! Local
  logical :: is_default
  !
  ! Use the full dynamic allowed by the kind 'bitmap_depth':
  lut_size = bitmap_dynamic_max-1  ! Last is used for blanking
  !
  call load_lut(gbl_colormap,.false.,lut_size+1,.true.,0,error)
  if (error)  return
  !
  ! Define the SIC variables related to images LUT
  call sic_defstructure('LUT',.true.,error)
  if (error)  return
  call sic_def_inte('LUT%MODE',      lut_mode,  0,1,.false.,error)
  call sic_def_logi('LUT%STATIC',    lut_static,    .true., error)
  call sic_def_inte('LUT%SIZE',      lut_size,  0,1,.true., error)
! call sic_def_real('LUT%LUT',       gbl_colormap%hue,1,lut_size,.true., error)
  call sic_def_real('LUT%HUE',       gbl_colormap%hue,1,lut_size,.false.,error)
  call sic_def_real('LUT%SATURATION',gbl_colormap%sat,1,lut_size,.false.,error)
  call sic_def_real('LUT%VALUE',     gbl_colormap%val,1,lut_size,.false.,error)
  call sic_def_real('LUT%RED',       gbl_colormap%r,  1,lut_size,.false.,error)
  call sic_def_real('LUT%GREEN',     gbl_colormap%g,  1,lut_size,.false.,error)
  call sic_def_real('LUT%BLUE',      gbl_colormap%b,  1,lut_size,.false.,error)
  !
  ! Blanking
  call sic_defstructure('LUT%BLANK',.true.,error)
  call sic_def_real('LUT%BLANK%HUE',       gbl_colormap%hue(gbl_colormap%size),0,1,.false.,error)
  call sic_def_real('LUT%BLANK%SATURATION',gbl_colormap%sat(gbl_colormap%size),0,1,.false.,error)
  call sic_def_real('LUT%BLANK%VALUE',     gbl_colormap%val(gbl_colormap%size),0,1,.false.,error)
  call sic_def_real('LUT%BLANK%RED',       gbl_colormap%r(gbl_colormap%size),  0,1,.false.,error)
  call sic_def_real('LUT%BLANK%GREEN',     gbl_colormap%g(gbl_colormap%size),  0,1,.false.,error)
  call sic_def_real('LUT%BLANK%BLUE',      gbl_colormap%b(gbl_colormap%size),  0,1,.false.,error)
  !
  is_default = .true.
  call protocol_loadlut(cw_device,gbl_colormap,is_default)
  !
end subroutine init_lut
!
subroutine load_lut(map,reuse,map_size,color,background,error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>load_lut
  use gtv_plot
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Load the appropriate LUT in the input 'map' colormap.
  !---------------------------------------------------------------------
  type(gt_lut),     intent(inout) :: map         !
  logical,          intent(in)    :: reuse       ! Reuse current user's colormap?
  integer(kind=4),  intent(in)    :: map_size    !
  logical,          intent(in)    :: color       ! If not reuse, generate colors?
  integer(kind=4),  intent(in)    :: background  !
  logical,          intent(inout) :: error       !
  !
  call gt_lut_alloc(map,map_size,error)
  if (error)  return
  !
  if (reuse .and. gbl_colormap%size.gt.0 .and. map%size.eq.gbl_colormap%size) then
    map = gbl_colormap
    !
  elseif (color) then
    ! Use default color LUT
    call gt_lut_default(map,map%size-1)
    ! Blanking
    map%r(map%size) = 1.0
    map%b(map%size) = 1.0
    map%g(map%size) = 1.0
    call rgb_to_hsv(map%r(map%size),map%g(map%size),map%b(map%size),  &
                    map%hue(map%size),map%sat(map%size),map%val(map%size))
    !
  elseif (background.eq.1) then
    ! Black LUT
    call gt_lut_rgb(map,map%size-1,1.,0.,1.,0.,1.,0.)
    ! Blanking
    map%r(map%size) = 1.0
    map%b(map%size) = 1.0
    map%g(map%size) = 1.0
    call rgb_to_hsv(map%r(map%size),map%g(map%size),map%b(map%size),  &
                    map%hue(map%size),map%sat(map%size),map%val(map%size))
    !
  else
    ! White LUT
    call gt_lut_rgb(map,map%size-1,0.,1.,0.,1.,0.,1.)
    ! Blanking
    map%r(map%size) = 0.0
    map%b(map%size) = 0.0
    map%g(map%size) = 0.0
    call rgb_to_hsv(map%r(map%size),map%g(map%size),map%b(map%size),  &
                    map%hue(map%size),map%sat(map%size),map%val(map%size))
  endif
  !
end subroutine load_lut
!
subroutine gtl_lutpen(line,error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gtl_lutpen
  use gtv_buffers
  use gtv_protocol
  use gtv_plot
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command:
  !  GTVL\LUT [Argum]
  !  1        [/PEN]
  !  2        [/EDIT]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  !
  if (sic_present(1,0)) then      ! LUT /PEN
    call pen_lut(line,error)
    if (lut_static) then
      return  ! LUT STATIC => nothing to redraw
    endif
    !
  elseif (sic_present(2,0)) then  ! LUT /EDIT
    call edit_lut
    if (lut_static) then
      return  ! LUT STATIC => nothing to redraw
    endif
    !
  else                            ! LUT [Argum]
    call gtl_lut(line,error)
    if (lut_static) then
      return  ! LUT STATIC => nothing to redraw
    endif
  endif
  if (error)  return
  !
  ! If the device has a static LUT, the plot must be re-drawn with the current LUT
  if (cw_device%map_static)  &
    call gtview('Color')  ! Update Color LUT
  !
end subroutine gtl_lutpen
!
subroutine gtl_lut(line,error)
  use gildas_def
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gtl_lut
  use gbl_message
  use gtv_plot
  use gtv_protocol
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command:
  !   LUT [Argum]  (no option)
  ! LOADS a color table read in a file written in free format,
  !   or defined by the Hue, Saturation, Value
  !   or Red Green Blue arrays,
  ! depending upon the current representation.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='LUT'
  character(len=80) :: argum,arguml
  integer :: i,nc
  logical :: is_default
  !
  arguml = 'LUT'  ! Default value
  call sic_ch (line,0,1,arguml,nc,.false.,error)
  if (error)  return
  argum=arguml
  call sic_upper(argum(1:nc))
  !
  select case (argum)
  case('DEFAULT')
    call gt_lut_default(gbl_colormap,gbl_colormap%size-1)
    !
  case('COLOR')
    call gt_lut_color(gbl_colormap,gbl_colormap%size-1)
    !
  case('BLACK')
    call gt_lut_rgb(gbl_colormap,gbl_colormap%size-1,1.,0.,1.,0.,1.,0.)
    ! Blanking
    gbl_colormap%r(gbl_colormap%size) = 0.0
    gbl_colormap%b(gbl_colormap%size) = 0.0
    gbl_colormap%g(gbl_colormap%size) = 0.0
    !
  case('WHITE')
    call gt_lut_rgb(gbl_colormap,gbl_colormap%size-1,0.,1.,0.,1.,0.,1.)
    ! Blanking
    gbl_colormap%r(gbl_colormap%size) = 1.0
    gbl_colormap%b(gbl_colormap%size) = 1.0
    gbl_colormap%g(gbl_colormap%size) = 1.0
    !
  case('RED')
    call gt_lut_rgb(gbl_colormap,gbl_colormap%size-1,0.,1.,0.,0.,0.,0.)
    !
  case('GREEN')
    call gt_lut_rgb(gbl_colormap,gbl_colormap%size-1,0.,0.,0.,1.,0.,0.)
    !
  case('BLUE')
    call gt_lut_rgb(gbl_colormap,gbl_colormap%size-1,0.,0.,0.,0.,0.,1.)
    !
  case('YELLOW')
    call gt_lut_rgb(gbl_colormap,gbl_colormap%size-1,0.,1.,0.,1.,0.,0.)
    !
  case('CYAN')
    call gt_lut_rgb(gbl_colormap,gbl_colormap%size-1,0.,0.,0.,1.,0.,1.)
    !
  case('MAGENTA')
    call gt_lut_rgb(gbl_colormap,gbl_colormap%size-1,0.,1.,0.,0.,0.,1.)
    !
  case('NULL')
    call gt_lut_rgb(gbl_colormap,gbl_colormap%size-1,0.,0.,0.,0.,0.,0.)
    !
  case('BLUERED')
    call gt_lut_bluered(gbl_colormap,gbl_colormap%size-1)
    !
  case('LUT')
    ! User re-defined LUT.
    !   From level 1 to gbl_colormap%size-1: the LUT colors
    !   Level gbl_colormap%size: the blanking color
    if (lut_mode.eq.hsv_mode) then
      do i=1,gbl_colormap%size
        gbl_colormap%sat(i) = max(0.0,min(gbl_colormap%sat(i),1.0))
        gbl_colormap%val(i) = max(0.0,min(gbl_colormap%val(i),1.0))
        gbl_colormap%hue(i) = max(0.0,min(gbl_colormap%hue(i),360.0))
        call hsv_to_rgb(gbl_colormap%hue(i),gbl_colormap%sat(i),gbl_colormap%val(i),  &
                        gbl_colormap%r(i),gbl_colormap%g(i),gbl_colormap%b(i))
      enddo
    else
      do i=1,gbl_colormap%size
        gbl_colormap%r(i) = max(0.0,min(1.0,gbl_colormap%r(i)))
        gbl_colormap%g(i) = max(0.0,min(1.0,gbl_colormap%g(i)))
        gbl_colormap%b(i) = max(0.0,min(1.0,gbl_colormap%b(i)))
        call rgb_to_hsv(gbl_colormap%r(i),gbl_colormap%g(i),gbl_colormap%b(i),  &
                        gbl_colormap%hue(i),gbl_colormap%sat(i),gbl_colormap%val(i))
      enddo
    endif
    !
  case('?')
    call gt_lut_list(error)
    return  ! This was just a display, no action to perform on graphical window
    !
  case default
    ! Read from file, blanking is excluded
    call gt_lut_fromfile(arguml,gbl_colormap,gbl_colormap%size-1,error)
    if (error)  return
    !
  end select
  !
  ! /REVERSE reverts the LUT just loaded
  if (sic_present(3,0)) then
    ! BLANKING is not taken into account
    call gt_lut_revert(gbl_colormap,gbl_colormap%size-1,error)
    if (error)  return
  endif
  !
  ! Convert the (eventually modified) blank color:
  if (lut_mode.eq.hsv_mode) then
    gbl_colormap%sat(gbl_colormap%size) = max(0.0,min(gbl_colormap%sat(gbl_colormap%size),1.0))
    gbl_colormap%val(gbl_colormap%size) = max(0.0,min(gbl_colormap%val(gbl_colormap%size),1.0))
    gbl_colormap%hue(gbl_colormap%size) = max(0.0,min(gbl_colormap%hue(gbl_colormap%size),360.0))
    call hsv_to_rgb(  &
      gbl_colormap%hue(gbl_colormap%size),gbl_colormap%sat(gbl_colormap%size),gbl_colormap%val(gbl_colormap%size),  &
      gbl_colormap%r(gbl_colormap%size),gbl_colormap%g(gbl_colormap%size),gbl_colormap%b(gbl_colormap%size))
  else
    gbl_colormap%r(gbl_colormap%size) = max(0.0,min(1.0,gbl_colormap%r(gbl_colormap%size)))
    gbl_colormap%g(gbl_colormap%size) = max(0.0,min(1.0,gbl_colormap%g(gbl_colormap%size)))
    gbl_colormap%b(gbl_colormap%size) = max(0.0,min(1.0,gbl_colormap%b(gbl_colormap%size)))
    call rgb_to_hsv(  &
      gbl_colormap%r(gbl_colormap%size),gbl_colormap%g(gbl_colormap%size),gbl_colormap%b(gbl_colormap%size),  &
      gbl_colormap%hue(gbl_colormap%size),gbl_colormap%sat(gbl_colormap%size),gbl_colormap%val(gbl_colormap%size))
  endif
  !
  is_default = .true.
  call protocol_loadlut(cw_device,gbl_colormap,is_default)
  !
end subroutine gtl_lut
!
subroutine gt_lut_list(error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gt_lut_list
  use gbl_message
  use gildas_def
  !---------------------------------------------------------------------
  ! @ private
  !  List all the LUTs available to the user.
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='LUT'
  integer(kind=4) :: nlut
  character(len=filename_length) :: lutdir
  character(len=132), allocatable :: lutfiles(:)
  integer(kind=4), allocatable :: buf(:)
  integer(kind=4), parameter :: mlutcode=12
  character(len=12) :: lutcodes(mlutcode)
  ! Data
  data lutcodes / 'DEFAULT','COLOR','BLUERED','BLACK','WHITE',  'RED',  &
                  'GREEN',  'BLUE', 'YELLOW', 'CYAN', 'MAGENTA','NULL' /
  !
  ! From internal code:
  call sic_ambigs_list(rname,seve%i,'LUTs available from internal code are:',lutcodes)
  !
  ! From file:
  lutdir = 'GAG_LUT:'
  call sic_resolve_log(lutdir)  ! Recursive
  call gag_directory(lutdir,'*.lut',lutfiles,nlut,error)
  if (error) return
  !
  ! Sort list for clarity:
  allocate(buf(nlut))
  call gch_trie(lutfiles,buf,nlut,132,error)
  deallocate(buf)
  if (error)  return
  !
  call sic_ambigs_list(rname,seve%i,'LUTs available from formatted files are:',lutfiles(1:nlut))
  !
  call gtv_message(seve%i,rname,  &
    'The cet-*.lut files have special features and naming convention. '// &
    'See HELP LUT CET for details.')
  !
end subroutine gt_lut_list
!
subroutine gtv_lut(error)
  use gtv_interfaces, except_this=>gtv_lut
  use gtv_tree
  use gtv_buffers
  use gtv_plot
  use gtv_graphic
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  !  Save the current bitmap color Look Up Table into the METACODE
  ! ---
  !   Threads status: thread safe
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='GTV_LUT'
  !
  call gtsegm('LUT',error)
  !
  call gt_lut_segdata(error)
  ! if (error) close the segment
  !
  call gtsegm_close(error)  ! Thread-safe
  if (error)  return
  !
end subroutine gtv_lut
!
subroutine gt_lut_segdata(error)
  use gtv_interfaces, except_this=>gt_lut_segdata
  use gtv_tree
  use gtv_buffers
  use gtv_plot
  use gtv_graphic
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Save the current bitmap color Look Up Table into the METACODE
  ! ---
  !   Threads status: thread safe
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='GTV_LUT'
  integer :: ier
  !
  call gtv_open_segments_for_writing_from_main()
  !
  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_lutcol
  call gt_lut_alloc(co_segment_data%lut,gbl_colormap%size,error)
  if (error)  goto 10
  !
  ! Copy
  co_segment_data%lut = gbl_colormap
  co_segment_data%lut%xlut = 0  ! X-equivalent is not yet available
  ! Save the LUT address for later use by images
  co_segment%head%lut => co_segment_data%lut
  !
10 continue
  !
  call gtv_close_segments_for_writing_from_main()
  !
end subroutine gt_lut_segdata
!
subroutine gti_lut(out,lut)
  use gtv_interfaces, except_this=>gti_lut
  use gtv_buffers
  use gtv_graphic
  use gtv_plot
  use gtv_tree
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Read the colormap Look Up Table from the metacode and use it for the
  ! display. Starting from this point, next drawn images will use this
  ! colormap instead of the current working colormap ('gbl_colormap').
  !---------------------------------------------------------------------
  type(gt_display), intent(in)    :: out  ! Output device
  type(gt_lut),     intent(inout) :: lut  ! LUT in the metacode
  ! Local
  logical :: is_default
  !
  if (.not.awake .or. error_condition) return
  !
  if (.not.lut_static)  return  ! The image LUT known by the device remains
    ! the global one (gbl_colormap). It should be a custom one only in the
    ! LUT STATIC case.
  !
  is_default = .false.
  call protocol_loadlut(out%dev,lut,is_default)
  !
end subroutine gti_lut
!
subroutine protocol_loadlut(dev,map,is_default)
  use gtv_interfaces, except_this=>protocol_loadlut
  use gtv_plot
  use gtv_protocol
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Fonction d'aiguillage du chargement d'une palette en fonction du
  ! protocole
  !---------------------------------------------------------------------
  type(gt_device), intent(in)    :: dev         ! Output device
  type(gt_lut),    intent(inout) :: map         ! Colormap
  logical,         intent(in)    :: is_default  ! Is it the default/global colormap?
  !
  if (map%size.le.0) return
  !
  if (dev%protocol.eq.p_x) then
    if (map%xlut.ne.0)  call xcolormap_delete(map%xlut)
    map%xlut = xcolormap_create(map%r,map%g,map%b,map%size,is_default)
  endif
  !
  ! The other protocols directly access the colormaps and do not
  ! need their own local copy.
  !
end subroutine protocol_loadlut
!
subroutine edit_lut
  use gtv_interfaces, except_this=>edit_lut
  use gtv_protocol
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command:
  !   LUT /EDIT
  !---------------------------------------------------------------------
  !
  if (cw_device%protocol.ne.p_x) then
    call gtv_message(seve%e,'EDIT_LUT','Only for graphical displays, sorry')
    return
  endif
  !
  call create_edit_lut_window
  !
end subroutine edit_lut
!
subroutine gt_lut_default(lut,size)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gt_lut_default
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Fill the input LUT with the default color LUT. The blanking is not
  ! taken into account here.
  !---------------------------------------------------------------------
  type(gt_lut),    intent(inout) :: lut   ! The LUT to be filled
  integer(kind=4), intent(in)    :: size  ! Size of LUT
  ! Local
  integer :: i,nborder,ilow,iup
  real :: hueshift
  !
  ! Rainbow from blue to violet, and min black and max white.
  hueshift = 90.
  nborder = nint(size*.12)
  ilow = nborder
  iup = size-nborder+1
  do i=1,size
    ! Hue
    lut%hue(i) = 360. * (size-i)/float(size) - hueshift
    lut%hue(i) = modulo(lut%hue(i),360.)  ! Between 0. and 360.
    ! Saturation
    if (i.gt.iup) then
      lut%sat(i) = float(size-i)/float(nborder-1)
    else
      lut%sat(i) = 1.
    endif
    ! Value
    if (i.lt.ilow) then
      lut%val(i) = float(i-1)/float(nborder-1)
    else
      lut%val(i) = 1.
    endif
    call hsv_to_rgb(lut%hue(i),lut%sat(i),lut%val(i),  &
                    lut%r(i),  lut%g(i),  lut%b(i))
  enddo
  !
end subroutine gt_lut_default
!
subroutine gt_lut_color(lut,size)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gt_lut_color
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Fill the input LUT with the "color" LUT (circular hue value, from
  ! red to red). The blanking is not taken into account here.
  !---------------------------------------------------------------------
  type(gt_lut),    intent(inout) :: lut   ! The LUT to be filled
  integer(kind=4), intent(in)    :: size  ! Size of LUT
  ! Local
  integer :: i
  !
  ! The old default colormap, from red to red
  do i=1,size
    lut%sat(i) = 1.0
    lut%val(i) = 1.0
    lut%hue(i) = (i-1)*360./float(size-1)
    call hsv_to_rgb(lut%hue(i),lut%sat(i),lut%val(i),  &
                    lut%r(i),  lut%g(i),  lut%b(i))
  enddo
  !
end subroutine gt_lut_color
!
subroutine gt_lut_rgb(lut,size,rmin,rmax,gmin,gmax,bmin,bmax)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gt_lut_rgb
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Fill the input LUT with the R, G and B levels growing linearly from
  ! 0. to Rmax, Gmax and Bmax respectively. The blanking is not taken
  ! into account here.
  !---------------------------------------------------------------------
  type(gt_lut),    intent(inout) :: lut        ! The LUT to be filled
  integer(kind=4), intent(in)    :: size       ! Size of LUT
  real(kind=4),    intent(in)    :: rmin,rmax  ! R extrema
  real(kind=4),    intent(in)    :: gmin,gmax  ! G extrema
  real(kind=4),    intent(in)    :: bmin,bmax  ! B extrema
  ! Local
  integer :: i
  real :: val
  !
  do i=1,size
    val = float(i-1)/float(size-1)  ! From 0. to 1.
    lut%r(i) = rmin + val * (rmax-rmin)
    lut%g(i) = gmin + val * (gmax-gmin)
    lut%b(i) = bmin + val * (bmax-bmin)
    !
    call rgb_to_hsv(lut%r(i),  lut%g(i),  lut%b(i),  &
                    lut%hue(i),lut%sat(i),lut%val(i))
  enddo
  !
end subroutine gt_lut_rgb
!
subroutine gt_lut_bluered(lut,size)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gt_lut_bluered
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Program-defined BLUERED Look-Up-Table.
  !---------------------------------------------------------------------
  type(gt_lut),    intent(inout) :: lut        ! The LUT to be filled
  integer(kind=4), intent(in)    :: size       ! Size of LUT
  ! Local
  integer(kind=4) :: i
  real(kind=4) :: l(3),bs,re
  !
  ! Define the limits of the 4 regimes:
  l(1) = size*0.15
  l(2) = size*0.50
  l(3) = size*0.7975
  !
  ! Blue intensity at start, red intensity at end
  bs = 0.23
  re = 0.19
  !
  ! 1st regime: dark blue to light blue
  do i=1,floor(l(1))
    lut%r(i) = 0.
    lut%g(i) = 0.
    lut%b(i) = bs + (1.-bs)*(i-1)/(l(1)-1)  ! From bs to 1
  enddo
  !
  ! 2nd regime: light blue to white
  do i=ceiling(l(1)),floor(l(2))
    lut%r(i) = (i-l(1))/(l(2)-l(1))  ! From 0 to 1
    lut%g(i) = (i-l(1))/(l(2)-l(1))  ! From 0 to 1
    lut%b(i) = 1.
  enddo
  !
  ! 3rd regime: from white to light red
  do i=ceiling(l(2)),floor(l(3))
    lut%r(i) = 1.
    lut%g(i) = (l(3)-i)/(l(3)-l(2))  ! From 1 to 0
    lut%b(i) = (l(3)-i)/(l(3)-l(2))  ! From 1 to 0
  enddo
  !
  ! 4th regime
  do i=ceiling(l(3)),size
    lut%r(i) = re + (1.-re)*(size-i)/(size-l(3))  ! From 1 to re
    lut%g(i) = 0.
    lut%b(i) = 0.
  enddo
  !
  ! Also fill the HSV values from RGB
  do i=1,size
    call rgb_to_hsv(lut%r(i),  lut%g(i),  lut%b(i),  &
                    lut%hue(i),lut%sat(i),lut%val(i))
  enddo
  !
end subroutine gt_lut_bluered
!
subroutine gt_lut_fromfile(name_in,cmap,ncol,error)
  use gildas_def
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gt_lut_fromfile
  use gbl_message
  use gtv_plot
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name_in  ! File name
  type(gt_lut),     intent(inout) :: cmap     ! Colormap to be filled
  integer(kind=4),  intent(in)    :: ncol     ! Number of colors in the colormap
  logical,          intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='LUT'
  integer :: i,ier,lun,nf,filelen
  character(len=filename_length) :: name,file
  type(gt_lut) :: filemap
  !
  ! Get the file name with path
  name = name_in
  if (.not.sic_findfile(name,file,'LUT#DIR:','.lut')) then
    call gtv_message(seve%e,rname,'No such file '//name_in)
    error = .true.
    return
  endif
  nf = len_trim(file)
  !
  ! Open the file
  ier = sic_getlun(lun)
  if (mod(ier,2).ne.1) then
    error = .true.
    return
  endif
  !
  ier = sic_open(lun,file(1:nf),'OLD',.true.)
  if (ier.ne.0) then
    call putios('E-LUT,  ',ier)
    error = .true.
    call sic_frelun(lun)
    return
  endif
  !
  ! 1) Get the number of lines in the file
  filelen = 0
  do
    read(lun,*,iostat=ier)
    if (ier.eq.-1) then
      ! Reached End-Of-File
      exit
    elseif (ier.ne.0) then
      call putios('E-LUT,  ',ier)
      goto 100
    endif
    filelen = filelen+1
  enddo
  !
  ! 2) Read in a colormap of correct size
  call gt_lut_alloc(filemap,filelen,error)
  if (error)  goto 100
  !
  rewind(unit=lun)
  do i=1,filelen
    read(lun,*,iostat=ier) filemap%r(i),filemap%g(i),filemap%b(i)
    if (ier.ne.0) then
      call putios('E-LUT,  ',ier)
      call gt_lut_dealloc(filemap,error)
      goto 100
    endif
  enddo
  close(unit=lun)
  call sic_frelun(lun)
  !
  ! 3) If the number of colors match, just copy one into the other. Else
  !    resample
  if (ncol.eq.filelen) then
    do i=1,ncol
      cmap%r(i) = filemap%r(i)
      cmap%g(i) = filemap%g(i)
      cmap%b(i) = filemap%b(i)
      call rgb_to_hsv(cmap%r(i),  cmap%g(i),  cmap%b(i),  &
                      cmap%hue(i),cmap%sat(i),cmap%val(i))
    enddo
  else
    call gt_lut_resample(filemap,filelen,cmap,ncol,.true.)
  endif
  !
  ! Clean
  call gt_lut_dealloc(filemap,error)
  return
  !
100 continue
  error = .true.
  close(unit=lun)
  call sic_frelun(lun)
  !
end subroutine gt_lut_fromfile
!
subroutine gt_lut_resample(cmapin,sizein,cmapout,sizeout,interpolate)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gt_lut_resample
  use gbl_message
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Resample the input colormap into the output colormap such as:
  !  cmapout(1) = cmapin(1)
  !  cmapout(sizeout) = cmapin(sizein)
  ! and the intermediate values are either interpolated or nearest
  ! neighbour.
  !---------------------------------------------------------------------
  type(gt_lut),    intent(in)    :: cmapin       !
  integer(kind=4), intent(in)    :: sizein       !
  type(gt_lut),    intent(inout) :: cmapout      !
  integer(kind=4), intent(in)    :: sizeout      !
  logical,         intent(in)    :: interpolate  !
  ! Local
  character(len=*), parameter :: rname='LUT'
  character(len=message_length) :: mess
  integer :: icol,il,ir,near
  real(4) :: rind,slope
  !
  write(mess,*) 'Resampling',sizein,'levels into a',sizeout,'levels colormap'
  call gtv_message(seve%d,rname,mess)
  !
  do icol=1,sizeout
    rind = float(icol-1) * float(sizein-1)/float(sizeout-1) + 1.
    if (rind.le.1.) then
      cmapout%r(icol) = cmapin%r(1)
      cmapout%g(icol) = cmapin%g(1)
      cmapout%b(icol) = cmapin%b(1)
      !
    elseif (rind.lt.sizein) then
      if (interpolate) then
        il = floor(rind)
        ir = ceiling(rind)
        rind = rind-float(il)
        !
        slope = cmapin%r(ir)-cmapin%r(il) ! / (ir-il) == 1
        cmapout%r(icol) = cmapin%r(il) + slope*rind
        !
        slope = cmapin%g(ir)-cmapin%g(il)
        cmapout%g(icol) = cmapin%g(il) + slope*rind
        !
        slope = cmapin%b(ir)-cmapin%b(il)
        cmapout%b(icol) = cmapin%b(il) + slope*rind
      else
        ! Nearest neighbour. Useful for "staircase" color maps
        near = nint(rind)
        cmapout%r(icol) = cmapin%r(near)
        cmapout%g(icol) = cmapin%g(near)
        cmapout%b(icol) = cmapin%b(near)
      endif
      !
    else
      cmapout%r(icol) = cmapin%r(sizein)
      cmapout%g(icol) = cmapin%g(sizein)
      cmapout%b(icol) = cmapin%b(sizein)
    endif
    !
    call rgb_to_hsv(cmapout%r(icol),  cmapout%g(icol),  cmapout%b(icol),  &
                    cmapout%hue(icol),cmapout%sat(icol),cmapout%val(icol))
  enddo
  !
end subroutine gt_lut_resample
!
subroutine gt_lut_revert(cmap,ncol,error)
  use gtv_interfaces, except_this=>gt_lut_revert
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !
  !---------------------------------------------------------------------
  type(gt_lut),    intent(inout) :: cmap   ! The color map to revert
  integer(kind=4), intent(in)    :: ncol   ! The number of elements to revert
  logical,         intent(inout) :: error  ! Logical error flag
  ! Local
  integer :: i
  type(gt_lut) :: reverted
  !
  call gt_lut_alloc(reverted,ncol,error)
  if (error)  return
  !
  do i=1,ncol
    reverted%r(i)   = cmap%r(ncol-i+1)
    reverted%g(i)   = cmap%g(ncol-i+1)
    reverted%b(i)   = cmap%b(ncol-i+1)
    reverted%hue(i) = cmap%hue(ncol-i+1)
    reverted%sat(i) = cmap%sat(ncol-i+1)
    reverted%val(i) = cmap%val(ncol-i+1)
  enddo
  !
  cmap%r(1:ncol) = reverted%r(:)
  cmap%g(1:ncol) = reverted%g(:)
  cmap%b(1:ncol) = reverted%b(:)
  cmap%hue(1:ncol) = reverted%hue(:)
  cmap%sat(1:ncol) = reverted%sat(:)
  cmap%val(1:ncol) = reverted%val(:)
  !
  ! Clean
  call gt_lut_dealloc(reverted,error)
  if (error)  return
  !
end subroutine gt_lut_revert
!
subroutine gt_lut_alloc(lut,size,error)
  use gtv_interfaces, except_this=>gt_lut_alloc
  use gbl_message
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Allocate the arrays of the input 'gt_lut' instance
  !---------------------------------------------------------------------
  type(gt_lut),    intent(inout) :: lut    !
  integer(kind=4), intent(in)    :: size   ! Requested lut size
  logical,         intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='GT_LUT_ALLOC'
  integer :: ier
  !
  lut%size = size
  allocate(lut%r(size),lut%g(size),lut%b(size),stat=ier)
  allocate(lut%hue(size),lut%sat(size),lut%val(size),stat=ier)
  !
  if (ier.ne.0) then
    call gtv_message(seve%e,rname,'Internal error, gt_lut allocation failed')
    error = .true.
    return
  endif
  !
end subroutine gt_lut_alloc
!
subroutine gt_lut_dealloc(lut,error)
  use gtv_interfaces, except_this=>gt_lut_dealloc
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Deallocate the arrays of the input 'gt_lut' instance
  !---------------------------------------------------------------------
  type(gt_lut), intent(inout) :: lut    !
  logical,      intent(inout) :: error  ! Logical error flag
  !
  lut%size = 0
  if (allocated(lut%r)) then
    deallocate(lut%r,lut%g,lut%b)
    deallocate(lut%hue,lut%sat,lut%val)
  endif
  !
end subroutine gt_lut_dealloc
!
subroutine gt_lut_fromeditor(r,g,b,sizein,error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gt_lut_fromeditor
  use gbl_message
  use gtv_plot
  use gtv_protocol
  !---------------------------------------------------------------------
  ! @ private
  !  Update the global colormap.
  !---------------------------------------------------------------------
  real(kind=4),    intent(in)    :: r(*)    ! R values
  real(kind=4),    intent(in)    :: g(*)    ! G values
  real(kind=4),    intent(in)    :: b(*)    ! B values
  integer(kind=4), intent(in)    :: sizein  ! LUT size, without the blanking color
  logical,         intent(inout) :: error   ! Logical error flag
  ! Local
  integer :: icol
  type(gt_lut), target :: inlut
  type(gt_lut), pointer :: worklut
  logical :: resample
  !
  if (sizein.eq.gbl_colormap%size-1) then
    ! Size match, direct copy to the global colormap:
    worklut => gbl_colormap
    resample = .false.
  else
    ! Size do not match, we need a temporary LUT object
    call gt_lut_alloc(inlut,sizein,error)
    if (error)  return
    worklut => inlut
    resample = .true.
  endif
  !
  do icol=1,sizein
    worklut%r(icol) = r(icol)
    worklut%g(icol) = g(icol)
    worklut%b(icol) = b(icol)
    call rgb_to_hsv(worklut%r(icol),  worklut%g(icol),  worklut%b(icol),  &
                    worklut%hue(icol),worklut%sat(icol),worklut%val(icol))
  enddo
  !
  if (resample) then
    ! Tranfer the temporary LUT to the global LUT
    call gt_lut_resample(inlut,sizein,gbl_colormap,gbl_colormap%size-1,.true.)
    call gt_lut_dealloc(inlut,error)
  endif
  !
  call protocol_loadlut(cw_device,gbl_colormap,.true.)
  !
  ! What if static LUT (i.e. one lut per image)?
  if (.not.lut_static)  &
    call gtview('Color')
  !
end subroutine gt_lut_fromeditor
