subroutine stamp(set,line,error,user_function)
  use gildas_def
  use gbl_constant
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>stamp
  use class_index
  use class_types
  use class_popup
  use plot_formula
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  ! CLASS Support routine for command
  !   STAMP [NX NY] [/LABEL [SCAN|NUMBER|SOURCE|LINE]]
  ! Makes a plot of "stamp format" spectra for NX by NY data of the
  ! index.
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set            !
  character(len=*),    intent(in)    :: line           ! Input command line
  logical,             intent(inout) :: error          ! Logical error flag
  logical,             external      :: user_function  ! intent(in)
  ! Local
  character(len=*), parameter :: rname='STAMP'
  type(observation) :: obs
  logical :: err_local
  integer :: nx,ny,nchar,ier,check_kind
  integer(kind=entry_length) :: nsp,isp,is
  real(kind=4) :: celx,cely,cdef0,cdef
  real(kind=plot_length) :: gx1new,gx2new,gy1new,gy2new,guynew,gx1s,gx2s,gy1s,gy2s,gxs
  character(len=80) :: ch
  !
  integer(kind=4) :: i, nc, nkey1
  integer(kind=4), parameter :: mvoc1=4
  character(len=12) :: voc1(mvoc1),arg1,key1
  logical :: doit(mvoc1)
  data voc1 /'NUMBER','SCAN','SOURCE','LINE'/
  integer(kind=4) :: inumb=1
  integer(kind=4) :: iscan=2
  integer(kind=4) :: isour=3
  integer(kind=4) :: iline=4
  !
  err_local = .false.
  check_kind = 0
  !
  ! Basic checks
  if (.not.filein_opened(rname,error))  return
  if (cx%next.le.1) then
     call class_message(seve%e,rname,'Index is empty')
     error = .true.
  endif
  if (error) return
  !
  if (set%modex.ne.'F') then
     call class_message(seve%w,rname,'Mode X is not fixed')
  endif
  if (set%modey.ne.'F') then
     call class_message(seve%w,rname,'Mode Y is not fixed')
  endif
  !
  ! Decode arguments
  nx = 0
  ny = 0
  call sic_i4(line,0,1,nx,.false.,error)
  if (error) return
  call sic_i4(line,0,2,ny,.false.,error)
  if (error) return
  !
  doit = .false.
  if (sic_present(1,0)) then
    do i=1,sic_narg(1)
      call sic_ke(line,1,i,arg1,nc,.false.,error)
      call sic_ambigs(rname,arg1,key1,nkey1,voc1,mvoc1,error)
      !
      if (error) return
      doit(nkey1) = .true.
    enddo
  endif
  !
  call gtclear
  ! get character size
  call sic_get_real('CHARACTER_SIZE',cdef,error)
  if (error) return
  cdef0 = cdef
  if (any(doit)) then
     cdef  = 0.5*cdef
     write(ch,1000) 'SET CHAR',cdef
     call gr_exec(ch(1:23))
     error = gr_error()
     if (error) return
  endif
  !
  ! First loop through headers to count records
  nsp = 0
  !
  ! First Loop to define how many Spectra
  call init_obs(obs)
  nsp = cx%next-1
  if (nx.lt.1) nx = nint(sqrt(1.*nsp))
  if (ny.lt.1) then
     ny = nsp/nx
     if (ny*nx .lt. nsp) ny=ny+1
  endif
  if (ny*nx.lt.nsp) call class_message(seve%w,rname,'More spectra in index than plotted')
  !
  ! Allocate IPOP  pointers,
  ! as well as XPOP and YPOP
  npop = min(nx*ny,nsp)
  if (allocated(ipop)) deallocate(ipop,xpop,ypop)
  allocate(ipop(npop),xpop(npop),ypop(npop),stat=ier)
  if (ier.ne.0) then
     call class_message(seve%e,rname,'Allocation error')
     error = .true.
     npop = 0
     goto 999
  endif
  !
  ! Get current GreG Box
  call get_box(gx1new,gx2new,gy1new,gy2new)
  !
  ! Define grid
  guynew=(gy2new-gy1new)/(guy2-guy1)
  !
  ! Size of a cell (cm)
  celx = (gx2new-gx1new)/nx
  cely = (gy2new-gy1new)/ny
  gx1s = gx1new
  gy1s = gy1new
  !
  ! Plot
  !
  ! Loop on spectra
  isp = 0
  do is=1,cx%next-1
     call get_it(set,obs,cx%ind(is),user_function,error)
     if (error) goto 999
     call newdat(set,obs,error)
     if (error) goto 999
     ! Abort if <^C>
     if (sic_ctrlc()) goto 999
     if (check_kind.eq.0) check_kind = obs%head%gen%kind
     if (obs%head%gen%kind.ne.check_kind) then
        write(ch,*) 'Inconsistent type of data ',obs%head%gen%kind,check_kind
        call class_message(seve%w,rname,ch)
        cycle ! Next spectrum
     endif
     !
     ! Define position of spectra
     gx2s = gx1s + celx
     gy2s = gy1s + cely
     write(ch,1000) 'SET BOX',gx1s,gx2s,gy1s,gy2s
     call gr_exec(ch)
     error = gr_error()
     if (error) goto 999
     isp = isp+1
     npop = isp
     ipop(isp) = obs%head%gen%num
     !
     ! Define plot limits
     guy  = (gy2s-gy1s)/(guy2-guy1)
     gux = (gx2s-gx1s)/(gux2-gux1)
     !
     ! Plot the 1D spectra
     call spectr1d(rname,set,obs,error)
     !
     ! Plot the grid if needed
     call gr_exec('BOX N N N')
     !
     ! Write the scan number if needed
     if (doit(inumb)) then
        write(ch,'(I0,A1,I2)') obs%head%gen%num,';',obs%head%gen%ver
        call sic_black(ch,nchar)
        call grelocate(gx1s,gy2s)
        call gr_exec ('LABEL "'//ch(1:nchar)//'" /CENTER 3')
     endif
     if (doit(iscan)) then
        write(ch,'(I0,A1,I2)') obs%head%gen%scan,'.',obs%head%gen%subscan
        call sic_black(ch,nchar)
        call grelocate(gx2s,gy2s)
        call gr_exec ('LABEL "'//ch(1:nchar)//'" /CENTER 1')
     endif
     if (doit(isour)) then
        gxs = 0.5*(gx1s+gx2s)
        call grelocate(gxs,gy2s)
        call gr_exec ('LABEL "'//obs%head%pos%sourc//'" /CENTER 2')
     endif
     if (doit(iline)) then
        gxs = 0.5*(gx1s+gx2s)
        call grelocate(gxs,gy1s)
        call gr_exec ('LABEL "'//obs%head%spe%line//'" /CENTER 8')
     endif
     ! next position
     gx1s = gx1s+celx
     if (gx1s.gt.gx2new-0.5*celx) then
        gx1s = gx1new
        gy1s = gy1s + cely
     endif
     !
     ! Exit if enough scan plotted
     if (isp.eq.nx*ny) exit
  enddo
  !
  ! Restore current values
999 continue
  !
  call free_obs(obs)
  !
  cdef = cdef0
  write(ch,1000) 'SET CHAR',cdef0
  call gr_exec(ch)
  err_local = gr_error()
  gx1s=gx1new
  gx2s=gx2new
  gy1s=gy1new
  gy2s=gy2new
  guy=guynew
  write(ch,1000) 'SET BOX',gx1s,gx2s,gy1s,gy2s
  call gr_exec(ch)
  err_local = gr_error()
  !
  ! Save for POPUP commands.
  cpop = cpop_stamp
  pgx1 = gx1s
  pgx2 = gx2s
  pgy1 = gy1s
  pgy2 = gy2s
  pux1 = 0.5
  pux2 = nx+0.5
  puy1 = 0.5
  puy2 = ny+0.5
  !
1000 format(a,4(1x,g14.7))
end subroutine stamp
