subroutine conmap(line,error)
  use gbl_message
  use gildas_def
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>conmap
  use greg_contours
  use greg_kernel
  use greg_pen
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for command
  !     RGMAP
  !   1     /ABSOLUTE aval
  !   2     /PERCENT  pval
  !   3     /KEEP filename [blank]
  !   4     /BLANKING bval Eval
  !   5     /GREY First nstep
  !   6     /PENS pos neg
  !   7     /ONLY Positive|Negative 
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='RGMAP'
  character(len=40) :: name
  character(len=80) :: chain
  real(kind=4) :: spval,epsval,alev,plev,zmin,zmax
  real(kind=4), pointer :: sub(:,:)
  integer(kind=4), allocatable :: iwork(:)
  real(kind=4), allocatable :: swork(:)
  integer(kind=4) :: nx_old,ny_old,kx,ky,minx,maxx,miny,maxy,n1,n2
  integer(kind=4) :: ipen_old,n,nc,jlev
  logical :: subset,fastmode
  real(kind=8) :: xref_old,yref_old
  integer(kind=size_length), parameter :: nsummits=5
  real(kind=4) :: boxx(nsummits),boxy(nsummits)
  integer(kind=4) :: basecolo,colid,ier
  integer, parameter :: max_gzmin=100
  real(kind=4) :: buf_gzmin(max_gzmin)
  integer(kind=4) :: ibuf_gz
  integer(kind=4) :: kchunk,chunky,nchunk,rchunk,chumin,chumax,mychunk
  !
  integer :: my_ncl, the_ncl, klev
  real :: my_cl(maxl), the_cl(maxl)
  real :: s, sign_only
  character(len=12) :: positive='POSITIVE'
  character(len=12) :: negative='NEGATIVE' 
  character(len=12) :: fast='FAST'
  character(len=12) :: quiet='QUIET'
  ! Saved variables
  save alev,plev
  !
  ! Check if something to do
  if (rg%status.eq.code_pointer_null) then
    call greg_message(seve%e,rname,'No map loaded')
    error = .true.
    return
  endif
  alev=1.0
  plev=1.0
  fastmode=.false.
  chunkpatch=.false.
  quietmode = sic_present(0,1)
  if (quietmode) then
    call sic_ke (line,0,1,name,nc,.true.,error)
    if (error) return
    nc = min(nc,12)
    fastmode=(name(1:nc).eq.fast(1:nc))
    quietmode=(name(1:nc).eq.quiet(1:nc))
  endif
  ! Grey scale and Chunks...
  mychunk=chunksize
  !
  ipen_old = cpen
  !
  ! Blanking Value ?
  if (sic_present(4,0)) then  ! /BLANKING
    call sic_r4 (line,4,1,spval,.true.,error)
    if (error) goto 999
    epsval = 0.  ! And not 'eblank' which can be negative <=> no blanking.
    call sic_r4 (line,4,2,epsval,.false.,error)
    if (error) goto 999
  else
    spval = cblank
    epsval = eblank
  endif
  if (sic_present(5,0)) then  ! /GREY
    ! Fill contours do not support BLANKING at all..
    call conblk(.false.,spval,epsval)
  elseif (epsval.ge.0.e0) then
    call conblk(.true.,spval,epsval)
    if (.not.quietmode) then
      write(chain,'(A,1PG13.6)') 'Contouring checks the blanking value ',spval
      call greg_message(seve%i,rname,chain)
    endif
  else
    call conblk(.false.,spval,epsval)
    if (.not.quietmode)  &
      call greg_message(seve%i,rname,'Contouring checks no blanking value')
  endif
  !
  ! Set contour factor
  if (sic_present(1,0)) then   ! Absolute
    if (sic_present(2,0)) then
      call greg_message(seve%e,rname,'Conflicting options : /ABSOLUTE and '//  &
      '/PERCENT')
      goto 999
    endif
    call sic_r4 (line,1,1,alev,.false.,error)
    if (error) goto 999
    qlev = alev
  elseif (sic_present(2,0)) then   ! Percent factor
    call sic_r4 (line,2,1,plev,.false.,error)
    if (error) goto 999
    call rgextr(0,zmin,zmax,rg%data,spval,epsval,.false.)
    qlev = plev*max(abs(zmin),abs(zmax))*0.01
  else                         ! No factor
    qlev = 1.
  endif
  !
  ! Select pens used for positive and negative contours
  ipen_pos = 0                 ! Default as requested by Steph...
  ipen_neg = 15
  if (sic_present(6,0)) then
    ipen_pos = cpen
    call sic_i4 (line,6,1,ipen_pos,.false.,error)
    if (error) goto 999
    ipen_neg = ipen_pos
    call sic_i4 (line,6,2,ipen_neg,.false.,error)
    if (error) goto 999
  endif
  if (.not.quietmode.and..not.sic_present(5,0)) then
    write(chain,'(A,I3,A,I3,A)') 'Pens',ipen_pos,' &',ipen_neg,  &
    ' used for positive & negative levels'
    call greg_message(seve%i,rname,chain)
  endif
  !
  ! Select levels to be processed through the /ONLY option
  sign_only = 0
  if (sic_present(7,0)) then
    call sic_ke (line,7,1,name,nc,.true.,error)
    if (name(1:nc).eq.positive(1:nc)) then
      sign_only = 1
    else if (name(1:nc).eq.negative(1:nc)) then
      sign_only = -1
    endif
  endif
  !
  if (sign_only.eq.0) then
    call conlev(qlev,cl,ncl)
    my_ncl = 0
  else 
    my_ncl = 0
    do jlev=1,ncl
      if (sign_only*cl(jlev).gt.0) then
        my_ncl = my_ncl+1
        my_cl(my_ncl) = cl(jlev)
      endif
    enddo
    if (my_ncl.eq.0) then
      call greg_message(seve%e,rname,'/ONLY: no valid level')
      goto 999
    endif
    call conlev(qlev,my_cl,my_ncl)
  endif
  !
  ! Keep contour on a formatted file ?
  if (sic_present(3,0)) then
    lout = .false.             ! Until OPEN
    if (eblank.lt.0) then
      call sic_r4 (line,3,2,blankfk,.true.,error)
      if (error) goto 999
    else
      blankfk = cblank
      call sic_r4 (line,3,2,blankfk,.false.,error)
      if (error) goto 999
    endif
    call sic_ch (line,3,1,name,nc,.true.,error)
    write(chain,'(A,1PG13.6)') '/KEEP writes the blanking value',blankfk
    call greg_message(seve%i,rname,chain)
    call sic_parsef (name,chain,' ','.dat')
    name=chain
    open(unit=jtmp,file=name,status='NEW',err=995)
    lout = .true.
  else
    lout = .false.
  endif
  !
  ! Check that map is visible, compute size of subset that can eventually been
  ! loaded:
  n1 = (gux1 - rg%xval)/rg%xinc + rg%xref
  n2 = (gux2 - rg%xval)/rg%xinc + rg%xref
  minx = min(n1,n2)-1
  maxx = max(n1,n2)+1
  if (maxx.lt.1 .or. minx.gt.rg%nx) then
    call greg_message(seve%w,rname,'Map is not visible')
    if (lout) close(unit=jtmp,status='DELETE')
    return
  endif
  n1 = (guy1 - rg%yval)/rg%yinc + rg%yref
  n2 = (guy2 - rg%yval)/rg%yinc + rg%yref
  miny = min(n1,n2)-1
  maxy = max(n1,n2)+1
  if (maxy.lt.1 .or. miny.gt.rg%ny) then
    call greg_message(seve%w,rname,'Map is not visible')
    if (lout) close(unit=jtmp,status='DELETE')
    return
  endif
  minx = max(1,minx)
  maxx = min(rg%nx,maxx)
  maxy = min(rg%ny,maxy)
  miny = max(1,miny)
  kx = maxx-minx+1
  ky = maxy-miny+1
  if (kx*ky.le.0) then
    call greg_message(seve%w,rname,'Map is not visible')
    if (lout) close(unit=jtmp,status='DELETE')
    return
  endif
  !
  if (sic_present(5,0)) then
    if (sic_present(3,0)) then
      call greg_message(seve%e,rname,'Conflicting options : /GREY and /KEEP')
      goto 999
    endif
    if (sic_present(4,0)) then
      call greg_message(seve%w,rname,'BLANKING ignored in Filled contour mode')
    endif
    lgrey = .true.
    ! Test a user-supplied Chunksize
    if (sic_present(0,1).and..not.quietmode.and..not.fastmode) then
      mychunk=chunksize
      call sic_i4(line,0,1,mychunk,.false.,error)
      error=.false.
    endif
    if (sic_present(5,1)) then
      call sic_i4 (line,5,1,ncolo,.false.,error)
      if (error) goto 999
      ncolo = max(1,min(ncolo,16))+7   ! intervalle 8-23
      if (sic_present(5,3)) then  ! RGMAP /GREY background
        call gtv_pencol_num2id(rname,ncolo,colid,error)
        if (error) goto 999
        call gr_segm('GREYBOX',error)
        call setcol(colid)
        boxx(1) = gx1
        boxy(1) = gy1
        boxx(2) = gx1
        boxy(2) = gy2
        boxx(3) = gx2
        boxy(3) = gy2
        boxx(4) = gx2
        boxy(4) = gy1
        boxx(5) = gx1
        boxy(5) = gy1
        call gr_fillpoly(nsummits,boxx,boxy)
        call gtsegm_close(error)
        ncolo=ncolo+1
        ncolo=mod((ncolo-9),16)+8
        ! ZZZ use parameters
      endif
      nstep = 1
      call sic_i4 (line,5,2,nstep,.false.,error)
      if (error) goto 999
      basecolo = ncolo
    else
      ncolo = 8
      nstep = 1
      basecolo = ncolo
    endif
  else
    lgrey = .false.
  endif
  !
  ! Test validity of "MYCHUNK" :
  ! do not perform contours on strips thinner than 4 pixels..
  if (mychunk.lt.kx*4) then
    mychunk=chunksize
    call greg_message(seve%w,rname,'Too small Chunk, using default value')
  endif
  !
  ! Optimize subset of "large" maps : load subset into work area;
  ! for grey contours, to maintain a reasonable size of the contour tree,
  ! we cut the map in chunks of CHUNKSIZE pixels and perform contour filling
  ! on these submaps. Hey, this should be done also for normal contours, as long
  ! as nobody asks for a printout. (or could be a "fast" option).
  if (.not.lgrey.and..not.fastmode) then
    subset = .false.
    sub => rg%data
    if (rg%nx*rg%ny.ge.mychunk) then
      if (1.5*kx*ky.lt.1.*rg%nx*rg%ny) then
        allocate(sub(kx,ky),stat=ier)
        if (ier.ne.0) goto 994
        subset = .true.
        ! Save old values
        nx_old = rg%nx
        ny_old = rg%ny
        rg%nx = kx
        rg%ny = ky
        xref_old = rg%xref
        yref_old = rg%yref
        rg%xref = xref_old + 1 - minx
        rg%yref = yref_old + 1 - miny
        call ext001 (rg%data,nx_old,ny_old,sub,rg%nx,rg%ny,minx,maxx,miny,maxy)
      endif
    endif
    ! Get work space for contours
994 n = max(rg%nx*rg%ny/5,1024)
    allocate(iwork(n),stat=ier)
    if (failed_allocate(rname,'iwork array',ier,error))  goto 998
    ilev = 0
    ! Contouring
    call conreg (rg%nx,rg%ny,sub,frstd,vectd,lastd,contd,iwork,n,error)
    deallocate(iwork)
    ! Reset pen and set last contoured map
    if (lout) close(unit=jtmp)
    cpen = ipen_old
    penupd = .true.
    if (subset) then
      deallocate(sub)
      rg%nx = nx_old
      rg%xref = xref_old
      rg%ny = ny_old
      rg%yref = yref_old
      subset = .false.
    endif
    return
  elseif (kx*ky.le.mychunk) then
    ! grey: subset of size =< MYCHUNK does not need to be cut in chunks.
    ! If NX*NY is =< MYCHUNK, it is even better (no subset extraction needed).
    ! Serves also for "fast" mode (which is able to contour ANY map).
    subset = .false.
    sub => rg%data
    if (rg%nx*rg%ny.gt.mychunk) then
      allocate(sub(kx,ky),stat=ier)
      if (ier.ne.0) goto 993
      subset = .true.
      ! Save old values
      nx_old = rg%nx
      ny_old = rg%ny
      rg%nx = kx
      rg%ny = ky
      xref_old = rg%xref
      yref_old = rg%yref
      rg%xref = xref_old + 1 - minx
      rg%yref = yref_old + 1 - miny
      call ext001(rg%data,nx_old,ny_old,sub,rg%nx,rg%ny,minx,maxx,miny,maxy)
    else
      !SG! PRINT *,'No truncation '
    endif
    !     Get work space for contours
993 n = max(rg%nx*rg%ny*2,1000)
    allocate(iwork(n),stat=ier)
    if (failed_allocate(rname,'iwork buffer',ier,error))  goto 998
    ilev = 0
    ! Contouring
    if (lgrey) then
      ! Remember the default Level list, because HIGHWATER
      ! assumes the list starts from 1 and is identical to that 
      ! loaded to conlev.
      the_ncl = ncl
      the_cl = cl
      if (my_ncl.ne.0) cl = my_cl
      ! Compute subset extrema to insure correct filling for adjacent patches
      ! by correct estimate of HIGHWATER. No, GZMIN is .NOT..EQ.RGMIN, and
      ! we have to recompute it (this because RGMIN is for a whole cube,
      ! or because we look only at a subset of the map).
      if (subset) then
!         This is incorrect, and overrides the current RG data extrema
!           call rgextr(0,gzmin,gzmax,sub,spval,epsval,.true.)
!         The generic code works...
        call gr4_sub_extrema(sub,rg%nx,rg%ny,spval,epsval,gzmin,gzmax, &
          & 1,rg%nx,1,rg%ny) 
      else
        call gr4_sub_extrema(sub,rg%nx,rg%ny,spval,epsval,gzmin,gzmax, &
          & minx,maxx, miny,maxy)
      endif
      call conreg(rg%nx,rg%ny,sub,frstg,vectg,lastg,contg,iwork,n,error)
      !
      ! Restore the default Level list
      cl = the_cl
      ncl = the_ncl
    else
      call conreg(rg%nx,rg%ny,sub,frstd,vectd,lastd,contd,iwork,n,error)
    endif
    deallocate(iwork)
    ! Reset pen and set last contoured map
    cpen = ipen_old
    penupd = .true.
    if (subset) then
      deallocate(sub)
      rg%nx = nx_old
      rg%xref = xref_old
      rg%ny = ny_old
      rg%yref = yref_old
      subset = .false.
    endif
    return
  else
    ! Grey: subset of size < MYCHUNK is cut in chunks (lines)
    ! compute subsets sizes:
    n = mychunk*2
    allocate(swork(mychunk),iwork(n),stat=ier)
    if (failed_allocate(rname,'swork and iwork arrays',ier,error))  goto 999
    ! Save old values
    nx_old = rg%nx
    ny_old = rg%ny
    xref_old = rg%xref
    yref_old = rg%yref
    rg%nx = kx
    chunky=mychunk/kx          !nb of lines in chunk
    nchunk=ky/chunky           !nb of submaps of KX*CHUNKY
    rchunk=ky-nchunk*chunky+nchunk-1   !1 pixel overlap
    do while (rchunk.ge.chunky)
      nchunk=nchunk+1
      rchunk=rchunk-chunky
    enddo
    rchunk=max(rchunk,0)
    if (rchunk.gt.0) nchunk=nchunk+1
    ncolo = basecolo
    chunkpatch=.true.
    !
    klev = 0
    do jlev=1,ncl     
      !
      ! Select only the requested Sign
      s = sign(1.0,cl(jlev))
      if (s*sign_only.lt.0) cycle
      if (klev.eq.0) klev = jlev  ! First level
      !
      rg%xref = xref_old+1-minx
      chumin = miny
      if (lgrey) then
        call gtv_pencol_num2id(rname,ncolo,colid,error)
        if (error) goto 999
        call gr_segm('GREY',error)
        call setcol(colid)
      else
        call gr_segm('CONTOUR',error)
        if (cl(jlev).lt.0.0) then
          call setpen(ipen_neg)
        else
          call setpen(ipen_pos)
        endif
      endif
      do kchunk=1,nchunk
        chumax=min((chumin+chunky-1),maxy)
        rg%ny =chumax-chumin+1
        rg%yref = yref_old+1-chumin
        call ext001(rg%data,nx_old,ny_old,swork,rg%nx,rg%ny,minx,maxx,  &
          chumin,chumax)
        call conlev(qlev,cl(jlev),1)
        ! Ilev is incremented by conreg
        ilev = jlev-1
        if (lgrey) then
          ! Compute subset extrema to insure correct filling for adjacent patches
          ! by correct estimate of HIGHWATER. note that here GZMIN is buffered.
          ibuf_gz = min(kchunk,max_gzmin)
          if (klev.eq.1.or.kchunk.ge.max_gzmin) then
            ! This would overwrite the RG extrema          
            !   call rgextr(0,buf_gzmin(ibuf_gz),gzmax,swork,spval,epsval,.true.)
            call gr4_sub_extrema(swork,rg%nx,rg%ny,spval,epsval,buf_gzmin(ibuf_gz),gzmax, &
              &   1,rg%nx,1,rg%ny)
          endif
! This looks incorrect and can overflow buf_gzmin
!          gzmin=buf_gzmin(kchunk)
! Use this instead
          gzmin = buf_gzmin(ibuf_gz)
          call conreg (rg%nx,rg%ny,swork,frstg,vectg,lastg,contg,iwork,n,error)
        else
          call conreg (rg%nx,rg%ny,swork,frstd,vectd,lastd,contd,iwork,n,error)
        endif
        if (error) then
          if (lgrey) then
            call greg_message(seve%i,rname,'Try a smaller ChunkSize (see HELP)')
          endif
          goto 992
        endif
        chumin = chumax
        cpen   = ipen_old
        penupd = .true.
      enddo
      if (lgrey) then
        ncolo = ncolo+nstep    ! another one
        ncolo=mod((ncolo-8),16)+8  ! pen [8-23]
      endif
      call gtsegm_close(error)
      if (error)  return
    enddo
992 continue
    !
    deallocate(iwork,swork)
    rg%nx = nx_old
    rg%xref = xref_old
    rg%ny = ny_old
    rg%yref = yref_old
    cpen = ipen_old
    penupd = .true.
    return
  endif
  !
995 call greg_message(seve%e,rname,'Cannot open the file requested by /KEEP')
  goto 999
998 continue
  if (subset) then
    deallocate(sub)
    rg%nx = nx_old
    rg%xref = xref_old
    rg%ny = ny_old
    rg%yref = yref_old
    subset = .false.
  endif
999 error=.true.
  if (lout) close(unit=jtmp,status='DELETE')
  cpen = ipen_old
  penupd = .true.
end subroutine conmap
!
subroutine ext001(a,nx,ny,b,kx,ky,minx,maxx,miny,maxy)
  use greg_interfaces, except_this=>ext001
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: nx        !
  integer(kind=4), intent(in) :: ny        !
  real(kind=4),    intent(in) :: a(nx,ny)  !
  integer(kind=4), intent(in) :: kx        !
  integer(kind=4), intent(in) :: ky        !
  real(kind=4)                :: b(kx,ky)  ! inout?
  integer(kind=4), intent(in) :: minx      !
  integer(kind=4), intent(in) :: maxx      !
  integer(kind=4), intent(in) :: miny      !
  integer(kind=4), intent(in) :: maxy      !
  ! Local
  integer(kind=4) :: ja,jb
  integer(kind=4) :: px
  !
  px = min(maxx-minx+1,kx)
  do ja = miny,min(maxy,ky+miny-1)
    jb = ja - miny + 1
    call r4tor4(a(minx,ja),b(1,jb),px)
  enddo
end subroutine ext001
!
subroutine frstd (icode,error)
  use gbl_message
  use greg_interfaces, except_this=>frstd
  use greg_contours
  use greg_kernel
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  !  For each contour level, puts (X,Y) Coordinates of contour into
  ! arrays XU,YU. Then plots the contour line using CONNECT
  !  Take care of grey scale contouring on SECAPA.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: icode  !
  logical,         intent(inout) :: error  !
  ! Local
  real(kind=4) :: cv
  character(len=message_length) :: chain
  !
  ! Beginning of new contour operation. Reset buffer and level counter.
  !
  ldd  = 0
  if (.not.chunkpatch) then
    if (icode.eq.2) then
      call gr_segm('CONTOUR',error)
      call setpen(ipen_neg)
    else
      call gr_segm('CONTOUR',error)
      call setpen(ipen_pos)
    endif
  endif
  mxu = maxu
  ilev = ilev+1
  cv=cl(ilev)*qlev
  if (.not.quietmode) then
    write(chain,'(A,I3,1X,1PG13.6)') 'Contour ',ilev,cv
    call greg_message(seve%i,'RGMAP',chain)
  endif
  if (lout) write(jtmp,*) blankfk,blankfk,'  Start contour ',ilev,cv
  link = .false.
end subroutine frstd
!
subroutine vectd(x,y,error)
  use greg_interfaces, except_this=>vectd
  use greg_contours
  use greg_kernel
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  !  For each contour level, puts (X,Y) Coordinates of contour into
  ! arrays XU,YU. Then plots the contour line using CONNECT
  !  Middle of contour line; Convert to user coordinates
  !  Return if still some place left in buffer
  !---------------------------------------------------------------------
  real(kind=4), intent(in)    :: x      !
  real(kind=4), intent(in)    :: y      !
  logical,      intent(inout) :: error  !
  !
  ldd=ldd+1
  xu(ldd) = (x-rg%xref)*rg%xinc + rg%xval
  yu(ldd) = (y-rg%yref)*rg%yinc + rg%yval
  if (ldd.lt.mxu) return
  !
  ! Flush buffer if full or if end of contour line
  !
  link = .true.
  call lastd(error)
end subroutine vectd
!
subroutine lastd(error)
  use gildas_def
  use greg_interfaces, except_this=>lastd
  use greg_contours
  use greg_kernel
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  !  End of contour line; Plots the contour line using CONNECT.
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  !
  ! Local
  integer(kind=size_length) :: k
  !
  call press_ctrlc(error)
  if (error) return
  ! Simple contour drawing
  call gr4_connect(ldd,xu,yu,0.e0,-1.e0)
  if (lout) then
    do k=1,ldd
      write(jtmp,*) xu(k),yu(k)
    enddo
    if (.not.link) then
      write(jtmp,*) blankfk,blankfk,'  End of part of contour ',ilev
    endif
  endif
  !
  ! Prepare buffer if linked contours;
  if (link) then
    xu(1) = xu(ldd)
    yu(1) = yu(ldd)
    ldd = 1
    link = .false.
  else
    ldd = 0
  endif
end subroutine lastd
!
subroutine contd(error)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>contd
  use greg_contours
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  !  End of contour line; Show it
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  !
  !
  call press_ctrlc(error)
  if (error) return
  !
  if (.not.chunkpatch)  call gtsegm_close(error)
  !
end subroutine contd
!
subroutine frstg(icode,error)
  use gildas_def
  use gbl_message
  use greg_interfaces, except_this=>frstg
  use greg_contours
  use greg_kernel
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  !   For each contour level, puts (X,Y) Coordinates of contour into
  ! arrays XU,YU. For Grey-scale.
  !   Call INIT_TREE to reset the filling capability
  !---------------------------------------------------------------------
  integer(kind=4)                :: icode  ! Unused
  logical,         intent(inout) :: error  !
  ! Local
  character(len=60) :: chain
  real :: cv
  !
  ! Beginning of new contour operation. Reset buffer and level counter.
  !
  ldd = 0
  mxu = 0
  call init_tree(icode,noclip_gris,error)
  if (error) return
  noclip_gris = .not.noclip_gris
  if (.not.quietmode.and..not.chunkpatch) then
    write(chain,'(A,I3,1X,1PG13.6)') 'Filling Contour ',ilev,cl(ilev)*qlev
    call greg_message(seve%i,'RGMAP',chain)
  endif
  ! Highwater is used to tell whether a void contour (at some level), should be
  ! filled anyway (to the extent of the map). This because contours BELOW the
  ! threshold should appear (as pixels below threshold appear on the pixel image:
  ! this capacity is needed when contouring several planes in a cube),
  ! and because, when a map is divided in chunks, some contours may not be drawn
  ! on a certain chunk just because all the pixels in the chunk would be above
  ! that contour level.
  cv=cl(ilev)*qlev
  highwater = cv.le.gzmin   !!  and NOT cl(ilev).le.gzmin
  !
end subroutine frstg
!
subroutine vectg(x,y,error)
  use gildas_def
  use gbl_message
  use greg_interfaces, except_this=>vectg
  use greg_contours
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  !  Middle of contour line; Convert to user coordinates.
  !  We should also clip here... If clipping applies, then a pseudo-end
  ! of contour appears
  !---------------------------------------------------------------------
  real(kind=4), intent(in) :: x      !
  real(kind=4), intent(in) :: y      !
  logical                  :: error  !
  ! Local
  character(len=*), parameter :: rname='VECTG'
  character(len=message_length) :: mess
  integer(kind=4) :: ier
  integer(kind=4), allocatable :: tmpx(:),tmpy(:)
  !
  if (mxu.eq.0) then
    mxu = maxu
    allocate(ixu(mxu),iyu(mxu),stat=ier)
    if (ier.ne.0)  goto 10
    !
  elseif (ldd.ge.mxu) then
    write(mess,'(A,I0)') 'Reallocating virtual memory to ',mxu
    call greg_message(seve%d,rname,mess)
    !
    allocate(tmpx(mxu),tmpy(mxu),stat=ier)
    if (ier.ne.0)  goto 10
    tmpx(:) = ixu(:)
    tmpy(:) = iyu(:)
    !
    deallocate(ixu,iyu,stat=ier)
    if (ier.ne.0)  goto 10
    allocate(ixu(2*mxu),iyu(2*mxu),stat=ier)
    if (ier.ne.0)  goto 10
    ixu(1:mxu) = tmpx(:)
    iyu(1:mxu) = tmpy(:)
    deallocate(tmpx,tmpy,stat=ier)
    if (ier.ne.0)  goto 10
    !
    mxu = 2*mxu
  endif
  ldd = ldd+1
  ixu(ldd) = nint(x*1e4)  ! Real centimeters to integer microns
  iyu(ldd) = nint(y*1e4)  ! Real centimeters to integer microns
  return
  !
  ! Allocation error
10 continue
  call greg_message(seve%e,rname,'Error allocating/deallocating arrays')
  error = .true.
  return
end subroutine vectg
!
subroutine lastg(error)
  use gildas_def
  use greg_interfaces, except_this=>lastg
  use greg_contours
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  !  End of contour line; Plots the contour line using FILL_VECT (to
  ! put a vector) and FILL_CONT (to end a contour)
  !---------------------------------------------------------------------
  logical, intent(inout) :: error
  ! Local
  integer(kind=4) :: c,c0,c1
  integer(kind=4) :: jx,jy,jx0,jy0,jx1,jy1,jxu,jyu,jxd,jyd
  logical :: up,down
  integer(kind=size_length) :: i,ndd
  !
  call press_ctrlc (error)
  if (error) return
  !
  ndd = ldd
  ldd = 0
  up = .true.
  down = .false.
  !
  ! Reset pen position
  jxu = ixu(1)
  jyu = iyu(1)
  !
  do i=1,ndd
    if (noclip_gris) then
      jx = ixu(i)
      jy = iyu(i)
      call fill_vect(jx,jy,error)
      if (error) return
    else
      if (up) then
        ! If down, flush previous contour
        if (down) then
          call fill_cont(error)
          if (error) return
        endif
      endif
      !
      ! Clip line jxu,jyu --> jxd,jyd
      jxd = ixu(i)
      jyd = iyu(i)
      jx0 = jxu
      jy0 = jyu
      jx1 = jxd
      jy1 = jyd
      jxu = jxd
      jyu = jyd
      !
      ! Change the end-points of the line (X0,Y0) - (X1,Y1)
      ! to clip the line at the window boundary.
      ! The algorithm is that of Cohen and Sutherland (ref: Newman & Sproull)
      !
      call grisclip(jx0,jy0,c0)
      call grisclip(jx1,jy1,c1)
      !
      do while (c0.ne.0 .or. c1.ne.0)
        if (iand(c0,c1).ne.0)  goto 10 ! line is invisible
        !
        c = c0
        if (c.eq.0) c = c1
        if (iand(c,1).ne.0) then   ! crosses XXBOX1
          jy = jy0 + 0.5 + float(jy1-jy0)*float(xxbox1-jx0)/float(jx1-jx0)
          jx = xxbox1
        elseif (iand(c,2).ne.0) then   ! crosses XXBOX2
          jy = jy0 + 0.5 + float(jy1-jy0)*float(xxbox2-jx0)/float(jx1-jx0)
          jx = xxbox2
        elseif (iand(c,4).ne.0) then   ! crosses YYBOX1
          jx = jx0 + 0.5 + float(jx1-jx0)*float(yybox1-jy0)/float(jy1-jy0)
          jy = yybox1
        elseif (iand(c,8).ne.0) then   ! crosses YYBOX2
          jx = jx0 + 0.5 + float(jx1-jx0)*float(yybox2-jy0)/float(jy1-jy0)
          jy = yybox2
        endif
        if (c.eq.c0) then
          jx0 = jx
          jy0 = jy
          call grisclip(jx,jy,c0)
        else
          jx1 = jx
          jy1 = jy
          call grisclip(jx,jy,c1)
        endif
      enddo
      !
      if (up) then
        call fill_vect(jx0,jy0,error)
        if (error) return
        up = .false.
      endif
      call fill_vect(jx1,jy1,error)
      if (error) return
      down = .true.
      up = (jx1.ne.jxu).or.(jy1.ne.jyu)
    endif
10  continue
  enddo  ! I
  !
  call fill_cont(error)
  !
end subroutine lastg
!
subroutine contg(error)
  use gildas_def
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>contg
  use greg_contours
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! End of contour line; Show it using FLUSH_TREE
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  !
  !
  call flush_tree(error)
  if (.not.chunkpatch)  call gtsegm_close(error)
  !
  if (allocated(ixu))  deallocate(ixu)
  if (allocated(iyu))  deallocate(iyu)
  call press_ctrlc (error)
  !
end subroutine contg
!
subroutine press_ctrlc(error)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>press_ctrlc
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  !
  ! Local
  logical :: ok
  character(len=1) :: answer
  !
  ok = sic_ctrlc()
  do while (ok)
    call sic_wpr('W-RGMAP, ^C pressed, Type C to continue, Q to QUIT',answer)
    if (answer.eq.'Q' .or. answer.eq.'q') then
      error = .true.
      return
    elseif (answer.eq.'C' .or. answer.eq.'c') then
      ok = .false.
    endif
  enddo
end subroutine press_ctrlc
!
subroutine grisclip(x,y,c)
  use greg_interfaces, except_this=>grisclip
  use greg_contours
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for the clipping algorithm ; called from DRAW and
  ! GRPOLY only. C is a 4 bit code indicating the relationship between
  ! point (X,Y) and the window boundaries ; 0 implies the point is
  ! within the window.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)  :: x  ! Position of point
  integer(kind=4), intent(in)  :: y  ! Position of point
  integer(kind=4), intent(out) :: c  ! Code
  !
  c = 0
  if (x.lt.xxbox1) then
    c = 1
  elseif (x.gt.xxbox2) then
    c = 2
  endif
  if (y.lt.yybox1) then
    c = c+4
  elseif (y.gt.yybox2) then
    c = c+8
  endif
end subroutine grisclip
