subroutine setgon(line,error)
  use gildas_def
  use phys_const
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>setgon
  use greg_kernel
  use greg_poly
  use greg_types
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !   POLYGON [(File)Name]
  ! 1  [/PLOT]
  ! 2  [/VARIABLE]
  ! 3  [/FILL [Icolor]]
  ! 4  [/RESET]
  ! 5  [/HATCH [Ipen] [Angle] [Separ] [Phase]]
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: line
  logical,          intent(out) :: error
  ! Local
  integer(kind=4), parameter :: iname = 0
  integer(kind=4), parameter :: ivar  = 2
  character(len=*), parameter :: rname='POLYGON'
  character(len=filename_length) :: polyname
  logical :: plot,fill,hatch,new,reset,isfile
  type(polygon_drawing_t) :: drawing
  !
  error = .false.
  plot = sic_present(1,0)
  fill = sic_present(3,0)
  hatch = sic_present(5,0)
  reset = sic_present(4,0)
  new  = sic_present(0,1) .or. .not.(plot.or.fill.or.hatch) .or. gpoly%ngon.eq.0
  !
  if (reset) then
    call greg_poly_reset(gpoly,'POLY',error)
    return  ! Always
  endif
  !
  if (new) then
    call greg_poly_parsename(line,iname,ivar,isfile,polyname,error)
    if (error) return
    call greg_poly_define(rname,polyname,isfile,gpoly,'POLY',error)
    if (error)  return
  endif
  !
  ! Real plot if requested
  if (plot .or. fill .or. hatch) then
    call parse_polygon_drawing(rname,line,3,5,drawing,error)
    if (error)  return
    drawing%contoured = plot
    call greg_poly_plot(gpoly,drawing,error)
    if (error)  return
  endif
  !
end subroutine setgon
!
subroutine greg_poly_reset(poly,varname,error)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>greg_poly_reset
  use greg_types
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  type(polygon_t),  intent(inout) :: poly     !
  character(len=*), intent(in)    :: varname  ! Support variable in Sic
  logical,          intent(inout) :: error    ! Input status preserved if no error here
  !
  poly%ngon = 0
  !
  call greg_poly_delvar(varname,error)
  if (error)  return
  !
end subroutine greg_poly_reset
!
subroutine greg_poly_delvar(varname,error)
  !---------------------------------------------------------------------
  ! @ private
  !  Delete the content of the polygon variable (NOT the structure
  ! itself: this is a program defined reserved name, always present)
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: varname  ! Support variable in Sic
  logical,          intent(inout) :: error    ! Input status preserved if no error here
  ! Local
  logical :: error2
  !
  error2 = .false.
  !
  if (varname.ne.'') then
    call sic_delvariable(trim(varname)//'%NXY',.false.,error2)
    call sic_delvariable(trim(varname)//'%X',.false.,error2)
    call sic_delvariable(trim(varname)//'%Y',.false.,error2)
    ! Also destroy those, they have no sense if polygon is updated
    call sic_delvariable(trim(varname)//'%SUM',.false.,error2)
    call sic_delvariable(trim(varname)//'%AREA',.false.,error2)
    call sic_delvariable(trim(varname)//'%RMS',.false.,error2)
    call sic_delvariable(trim(varname)//'%NPIX',.false.,error2)
    call sic_delvariable(trim(varname)//'%MIN',.false.,error2)
    call sic_delvariable(trim(varname)//'%MAX',.false.,error2)
    error2 = .false.  ! Not an error if not found
  endif
  !
  if (error2)  error = .true.
  !
end subroutine greg_poly_delvar
!
subroutine greg_poly_define(rname,srcname,srcisfile,poly,varname,error)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>greg_poly_define
  use greg_types
  !---------------------------------------------------------------------
  ! @ public
  !  Define or define a polygon from a source (variable or file)
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: rname      !
  character(len=*), intent(in)    :: srcname    ! Source name
  logical,          intent(in)    :: srcisfile  ! Source is a file or variable?
  type(polygon_t),  intent(inout) :: poly       !
  character(len=*), intent(in)    :: varname    ! Support variable in Sic
  logical,          intent(inout) :: error      !
  !
  call greg_poly_load(rname,srcisfile,srcname,poly,error)
  if (error) then
    poly%ngon = 0
    continue  ! Also delete the variable for safety
  endif
  !
  call greg_poly_delvar(varname,error)
  if (error)  return
  !
  if (poly%ngon.ne.0 .and. varname.ne.'') then
    call sic_def_inte(trim(varname)//'%NXY',poly%ngon,0,1,.true.,error)
    call sic_def_dble(trim(varname)//'%X',poly%xgon,1,poly%ngon,.true.,error)
    call sic_def_dble(trim(varname)//'%Y',poly%ygon,1,poly%ngon,.true.,error)
    if (error)  return
  endif
  !
end subroutine greg_poly_define
!
subroutine greg_poly_plot1(poly,error)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>greg_poly_plot1
  use greg_pen
  use greg_types
  !---------------------------------------------------------------------
  ! @ public-generic greg_poly_plot
  !  Draw the input polygon (contours only) with current pen
  !---------------------------------------------------------------------
  type(polygon_t), intent(in)    :: poly
  logical,         intent(inout) :: error
  ! Local
  type(polygon_drawing_t) :: drawing
  !
  drawing%contoured = .true.
  call inqpen(drawing%cpen)
  drawing%filled = .false.
  drawing%hatched = .false.
  !
  call greg_poly_plot2(poly,drawing,error)
  if (error)  return
  !
end subroutine greg_poly_plot1
!
subroutine greg_poly_plot2(poly,drawing,error)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>greg_poly_plot2
  use greg_pen
  use greg_types
  !---------------------------------------------------------------------
  ! @ public-generic greg_poly_plot
  !  Draw the input polygon:
  !  - contoured, and/or
  !  - filled, and/or
  !  - hatched
  !---------------------------------------------------------------------
  type(polygon_t),         intent(in)    :: poly     !
  type(polygon_drawing_t), intent(in)    :: drawing  !
  logical,                 intent(inout) :: error    !
  ! Local
  integer(kind=4) :: icol_old,ipen_old
  integer(kind=size_length) :: ngon_sl
  !
  if (poly%ngon.le.2) then
    call greg_message(seve%e,'POLYGON','No polygon defined')
    error = .true.
    return
  endif
  !
  call inqcol(icol_old)
  call inqpen(ipen_old)
  if (penupd)  call setpen(cpen)
  !
  ! Contouring, filling and hatching can be combined, but we need 3
  ! different GTV segments with their own attributes each
  if (drawing%contoured) then
    call gtsegm('POLYGON',error)
    call setpen(drawing%cpen)
    !
    call gr8_connect(poly%ngon+1,poly%xgon,poly%ygon,0.d0,-1.d0)
    !
    call gtsegm_close(error)  ! Close the segment before resetting the color
    call setpen(ipen_old)
  endif
  !
  if (drawing%filled) then
    call gtsegm('POLYGON',error)
    call setcol(drawing%fcolor)
    !
    ngon_sl = poly%ngon+1
    call gr8_ufill(ngon_sl,poly%xgon,poly%ygon)
    !
    call gtsegm_close(error)
    call setcol(icol_old)
  endif
  !
  if (drawing%hatched) then
    call gtsegm('POLYGON',error)
    call setpen(drawing%hpen)
    !
    ngon_sl = poly%ngon+1
    call gr8_hatch('POLYGON',ngon_sl,poly%xgon,poly%ygon,  &
                   drawing%hangle,drawing%hsepar,drawing%hphase,error)
    if (error)  continue
    !
    call gtsegm_close(error)
    call setpen(ipen_old)
  endif
  !
end subroutine greg_poly_plot2
!
subroutine meanva(line,error)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>meanva
  use greg_kernel
  use greg_poly
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: line
  logical,          intent(out) :: error
  ! Global
  include 'gbl_pi.inc'
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='MEAN'
  real(kind=4) :: sum,aire,mean,sigma,prev_sigma,minmax(2)
  integer(kind=4) :: npix
  real(kind=4) :: nsig_clip
  real(kind=4) :: b,eb,range,center
  logical :: clip,quiet
  !
  save sum,aire,sigma,npix,minmax  ! Support for Greg variables
  !
  error = .false.
  if (gpoly%ngon.le.2) then
    call greg_message(seve%e,rname,'No polygon defined')
    error = .true.
  endif
  if (rg%status.eq.code_pointer_null) then
    call greg_message(seve%e,rname,'No map loaded')
    error = .true.
  endif
  if (error) return
  !
  ! Define a variable to handle the result
  if (sic_varexist('POLY%AREA')) call sic_delvariable('POLY%AREA',.false.,error)
  call sic_def_real ('POLY%AREA',aire,0,0,.true.,error)
  if (sic_varexist('POLY%SUM')) call sic_delvariable('POLY%SUM',.false.,error)
  call sic_def_real ('POLY%SUM',sum,0,0,.true.,error)
  if (sic_varexist('POLY%RMS')) call sic_delvariable('POLY%RMS',.false.,error)
  call sic_def_real ('POLY%RMS',sigma,0,0,.true.,error)
  if (sic_varexist('POLY%NPIX')) call sic_delvariable('POLY%NPIX',.false.,error)
  call sic_def_inte('POLY%NPIX',npix,0,0,.true.,error)
  if (sic_varexist('POLY%MIN')) call sic_delvariable('POLY%MIN',.false.,error)
  call sic_def_real('POLY%MIN',minmax(1),0,0,.true.,error)
  if (sic_varexist('POLY%MAX')) call sic_delvariable('POLY%MAX',.false.,error)
  call sic_def_real('POLY%MAX',minmax(2),0,0,.true.,error)
  !
  b=cblank
  eb=eblank
  quiet = sic_present(0,1)
  clip = sic_present(1,0)
  if (clip) then
    call sic_r4 (line,1,1,nsig_clip,.true.,error)
    if (nsig_clip.le.0.0) then
      call greg_message(seve%e,rname,'Illegal clipping level')
      error = .true.
      return
    endif
  endif
  !
  call gr8_moments(rg%data,gpoly,b,eb,.false.,center,range,sum,aire,npix,  &
    mean,sigma,minmax)
  if (clip) then
    prev_sigma = maxr4
    do while (sigma.le.0.9*prev_sigma.and.sigma.gt.0)
      prev_sigma = sigma
      center = mean
      range  = sigma*nsig_clip
      call gr8_moments(rg%data,gpoly,b,eb,.true.,center,range,sum,aire,npix,  &
        mean,sigma,minmax)
    enddo
  endif
  if (quiet) return
  call print_mean(sum,aire,npix,mean,sigma,minmax)
end subroutine meanva
!
subroutine gr8_moments(z,poly,b,eb,clip,center,range,sum,aire,npix,mean,  &
  sigma,minmax)
  use phys_const
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>gr8_moments
  use greg_types
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  ! Compute statistics about the regular grid array within a N-gon
  !---------------------------------------------------------------------
  real(kind=4),    intent(in)  :: z(*)       ! Regular grid array
  type(polygon_t), intent(in)  :: poly       ! Current polygon
  real(kind=4),    intent(in)  :: b          ! Blanking value
  real(kind=4),    intent(in)  :: eb         ! Tolerance on blanking
  logical,         intent(in)  :: clip       ! Clip out of range values
  real(kind=4),    intent(in)  :: center     ! Center of accepted interval
  real(kind=4),    intent(in)  :: range      ! Half width of accepted interval
  real(kind=4),    intent(out) :: sum        ! Integrated map value
  real(kind=4),    intent(out) :: aire       ! Area of polygon
  integer(kind=4), intent(out) :: npix       ! Number of interior pixels
  real(kind=4),    intent(out) :: mean       ! Mean map value
  real(kind=4),    intent(out) :: sigma      ! RMS value
  real(kind=4),    intent(out) :: minmax(2)  ! Min and max values
  ! Local
  real(kind=8) :: x,y,s1,s2,value
  integer(kind=4) :: i,j,s0,imin,imax,jmin,jmax
  !
  s0 = 0
  s1 = 0.
  s2 = 0.
  sigma = 0.
  mean = 0.
  !
  ! Avoid exploring all the Map by finding IMIN,IMAX,JMIN,JMAX
  if (rg%xinc.gt.0.) then
    imin = max (1,    int((poly%xgon1-rg%xval)/rg%xinc+rg%xref) )
    imax = min (rg%nx,int((poly%xgon2-rg%xval)/rg%xinc+rg%xref)+1 )
  else
    imin = max (1,    int((poly%xgon2-rg%xval)/rg%xinc+rg%xref) )
    imax = min (rg%nx,int((poly%xgon1-rg%xval)/rg%xinc+rg%xref)+1 )
  endif
  if (rg%yinc.gt.0.) then
    jmin = max (1,    int((poly%ygon1-rg%yval)/rg%yinc+rg%yref) )
    jmax = min (rg%ny,int((poly%ygon2-rg%yval)/rg%yinc+rg%yref)+1 )
  else
    jmin = max (1,    int((poly%ygon2-rg%yval)/rg%yinc+rg%yref) )
    jmax = min (rg%ny,int((poly%ygon1-rg%yval)/rg%yinc+rg%yref)+1 )
  endif
  !
  ! Now explore a reasonable part of the map
  if (eb.lt.0.0) then
    ! Blanking is disabled
    minmax(:) = z((jmin-1)*rg%nx+imin)  ! First value is valid
    do j=jmin,jmax
      do i=imin,imax
        value = z((j-1)*rg%nx+i)
        if (.not.clip.or.abs(value-center).le.range) then
          x = (i-rg%xref)*rg%xinc+rg%xval
          y = (j-rg%yref)*rg%yinc+rg%yval
          if (greg_poly_inside(x,y,poly)) then
            s0 = s0 + 1
            s1 = s1 + value
            s2 = s2 + value**2
            if (minmax(1).gt.value)  minmax(1) = value  ! Min
            if (minmax(2).lt.value)  minmax(2) = value  ! Max
          endif
        endif
      enddo
    enddo
  else
    ! Blanking is enabled
    minmax(:) = b  ! First valid value is not known
    do j=jmin,jmax
      do i=imin,imax
        value = z((j-1)*rg%nx+i)
        if (.not.clip.or.abs(value-center).le.range) then
          if (abs(value-b).gt.eb) then
            x = (i-rg%xref)*rg%xinc+rg%xval
            y = (j-rg%yref)*rg%yinc+rg%yval
            if (greg_poly_inside(x,y,poly)) then
              s0 = s0 + 1
              s1 = s1 + value
              s2 = s2 + value**2
              if (minmax(1).eq.b) then
                minmax(1) = value
              elseif (minmax(1).gt.value) then
                minmax(1) = value  ! Min
              endif
              if (minmax(2).eq.b) then
                minmax(2) = value
              elseif (minmax(2).lt.value) then
                minmax(2) = value  ! Max
              endif
            endif
          endif
        endif
      enddo
    enddo
  endif
  !
  x = abs(rg%xinc*rg%yinc)
  sum = s1*x
  aire = s0*x
  npix = s0
  if (s0.ne.0) then
    s1 = s1 / s0
    mean = s1  ! Downcast to single precision, do not reuse below
    s2 = s2 / s0
    sigma = sqrt(s2-s1**2)
  endif
end subroutine gr8_moments
!
subroutine print_mean(sum,aire,npix,mean,sigma,minmax)
  use phys_const
  use gbl_message
  use greg_interfaces, except_this=>print_mean
  use greg_wcs
  !---------------------------------------------------------------------
  ! @ private
  ! Print statistics about the regular grid array within a N-gon
  !---------------------------------------------------------------------
  real(kind=4),    intent(in) :: sum        ! Integrated map value
  real(kind=4),    intent(in) :: aire       ! Area of polygon
  integer(kind=4), intent(in) :: npix       ! Number of pixels within polygon
  real(kind=4),    intent(in) :: mean       ! Mean map value
  real(kind=4),    intent(in) :: sigma      ! RMS value
  real(kind=4),    intent(in) :: minmax(2)  ! Min and max values
  ! Local
  character(len=*), parameter :: rname='MEAN'
  character(len=80) :: chain
  !
  if (aire.le.0) then
    call greg_message(seve%e,rname,'No Valid Pixels Found inside Polygon')
    return
  endif
  if (gproj%type.ne.p_none) then
    if (u_angle.eq.u_degree) then
      write (chain,100) npix,aire*(180.0d0/pi)*(180.0d0/pi),  &
                        ' Arc. Deg. squared'
      call greg_message(seve%i,rname,chain)
      write(chain,101) sum*(180.0d0/pi)*(180.0d0/pi),  &
                       ' (Map Units * Arc. Deg. squared)'
      call greg_message(seve%i,rname,chain)
      !
    elseif (u_angle.eq.u_minute) then
      write (chain,100) npix,aire*(10800.0d0/pi)*(10800.0d0/pi),  &
                        ' Arc. Min. squared'
      call greg_message(seve%i,rname,chain)
      write(chain,101) sum*(10800.0d0/pi)*(10800.0d0/pi),  &
                       ' (Map Units * Arc. Min. squared)'
      call greg_message(seve%i,rname,chain)
      !
    elseif (u_angle.eq.u_second) then
      write (chain,100) npix,aire*6.48d5/pi*6.48d5/pi,  &
                        ' Arc. Sec. squared'
      call greg_message(seve%i,rname,chain)
      write(chain,101) sum*6.48d5/pi*6.48d5/pi,  &
                       ' (Map Units * Arc. Sec. squared)'
      call greg_message(seve%i,rname,chain)
      !
    else
      write (chain,100) npix,aire,' Radians squared'
      call greg_message(seve%i,rname,chain)
      write(chain,101) sum,' (Map Units * Radians squared)'
      call greg_message(seve%i,rname,chain)
    endif
  else
    write (chain,100) npix,aire,' User Units squared'
    call greg_message(seve%i,rname,chain)
    write(chain,101) sum,' (Map Units * User Units Squared)'
    call greg_message(seve%i,rname,chain)
  endif
  !
  write(chain,102) mean,sigma
  call greg_message(seve%i,rname,chain)
  !
  write(chain,103) minmax(1),minmax(2)
  call greg_message(seve%i,rname,chain)
  !
100 format('Found ',i0,' non-blanked pixels, of area:',1pg11.4,a)
101 format('Integrated intensity:',1pg13.6,a)
102 format('Mean value: ',1pg12.5,', r.m.s.: ',1pg12.5)
103 format('Min value: ',1pg12.5,', max value: ',1pg12.5)
end subroutine print_mean
!
subroutine greg_poly_loadsub(rname,poly,lun,chain,error)
  use gildas_def
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>greg_poly_loadsub
  use greg_types
  !---------------------------------------------------------------------
  ! @ private
  !  Defines a polygon, either from file, from variable, or with the
  ! cursor.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: rname  ! Calling command name
  type(polygon_t),  intent(out)   :: poly   ! Defined polygon
  integer(kind=4),  intent(in)    :: lun    ! Logical unit number (0=>Cursor)
  character(len=*), intent(in)    :: chain  ! Variable name
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  integer(kind=index_length) :: ng
  character(len=message_length) :: mess
  !
  ! Read from a file
  if (lun.ne.0) then
    ng = 0
    do while (.true.)
      ng = ng+1
      read(lun,*,err=99,end=20) poly%xgon(ng),poly%ygon(ng)
      if (ng.ge.mgon) then
        write (mess,'(A,I4)') 'Too many vertices, truncated to ',mgon-1
        call greg_message(seve%e,rname,mess)
        exit  ! loop
      endif
    enddo
20  poly%ngon = ng-1
    !
  elseif (chain.ne."") then
    call greg_poly_variable(rname,chain,poly,error)
    if (error)  return
    !
  else
    ! Use the cursor to set up the summits
    call greg_poly_cursor(rname,poly,error)
    if (error)  return
  endif
  !
  ! Setup the polygon data structure
  if (poly%ngon.ge.mgon) then
    call greg_message(seve%e,rname,'Too many vertices, truncated')
    error = .true.
  endif
  poly%xgon(poly%ngon+1) = poly%xgon(1)
  poly%ygon(poly%ngon+1) = poly%ygon(1)
  poly%xgon1 = poly%xgon(1)
  poly%xgon2 = poly%xgon(1)
  poly%ygon1 = poly%ygon(1)
  poly%ygon2 = poly%ygon(1)
  do ng=1,poly%ngon
    poly%dxgon(ng) = poly%xgon(ng+1)-poly%xgon(ng)
    if (poly%xgon(ng+1).lt.poly%xgon1) then
      poly%xgon1 = poly%xgon(ng+1)
    elseif (poly%xgon(ng+1).gt.poly%xgon2) then
      poly%xgon2 = poly%xgon(ng+1)
    endif
    poly%dygon(ng) = poly%ygon(ng+1)-poly%ygon(ng)
    if (poly%ygon(ng+1).lt.poly%ygon1) then
      poly%ygon1 = poly%ygon(ng+1)
    elseif (poly%ygon(ng+1).gt.poly%ygon2) then
      poly%ygon2 = poly%ygon(ng+1)
    endif
  enddo
  poly%yeps = (poly%ygon2-poly%ygon1)*1.d-9
  poly%xout = poly%xgon1-0.01*(poly%xgon2-poly%xgon1)
  return
  !
99 call greg_message(seve%e,rname,'Error reading input file')
  error = .true.
  !
end subroutine greg_poly_loadsub
!
subroutine greg_poly_variable(rname,varname,poly,error)
  use gbl_format
  use gbl_message
  use sic_types
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>greg_poly_variable
  use greg_types
  !---------------------------------------------------------------------
  ! @ private
  ! Define the polygon from a Sic variable name. The variables can be:
  !  - a real or double array of the form:
  !       VAR[NXY,2]  Real or Double
  !  - a structure of the form:
  !       VAR%NXY         Integer or Long
  !       VAR%X[VAR%NXY]  Real or Double
  !       VAR%Y[VAR%NXY]  Real or Double
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: rname    ! Calling routine name
  character(len=*), intent(in)    :: varname  ! Sic variable name
  type(polygon_t),  intent(out)   :: poly     ! Defined polygon
  logical,          intent(inout) :: error    ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  logical :: found
  type(sic_descriptor_t) :: descr
  integer(kind=4) :: formx,formy,ngon,lv
  integer(kind=address_length) :: ipx,ipy
  character(len=message_length) :: mess
  !
  lv = len_trim(varname)
  if (varname(lv:lv).eq.'%') lv = lv-1
  !
  found = .false.  ! Not verbose
  call sic_descriptor(varname(1:lv),descr,found)
  if (.not.found) then
    call greg_message(seve%e,rname,'No such variable '//varname)
    error = .true.
    return
  endif
  !
  if (descr%type.lt.0) then  ! Numeric
    if (descr%dims(2).ne.2 .or. descr%dims(3).gt.1) then
      call greg_message(seve%e,rname,'Variable must be of size [NXY,2]')
      error = .true.
      return
    endif
    ngon = descr%dims(1)
    ipx = gag_pointer(descr%addr,memory)
    formx = descr%type
    ipy = gag_pointer(descr%addr,memory)+descr%size/2  ! Generic R*4 and R*8
    formy = descr%type
    !
  elseif (descr%type.eq.0) then  ! Structure
    call sic_get_inte(varname(1:lv)//'%NXY',ngon,error)
    if (error) then
      call greg_message(seve%e,rname,'No such variable '//varname(1:lv)//'%NXY')
      return
    endif
    !
    found = .true.  ! Verbose
    call sic_descriptor(varname(1:lv)//'%X',descr,found)
    if (.not.found) then
      error = .true.
      return
    endif
    formx = descr%type
    ipx = gag_pointer(descr%addr,memory)
    !
    found = .true.  ! Verbose
    call sic_descriptor(varname(1:lv)//'%Y',descr,found)
    if (.not.found) then
      error = .true.
      return
    endif
    formy = descr%type
    ipy = gag_pointer(descr%addr,memory)
    !
  else
    call greg_message(seve%e,rname,'Unsupported variable type')
    error = .true.
    return
  endif
  !
  if (ngon.ge.mgon) then
    write (mess,'(A,I0)') 'Too many vertices, truncated to ',mgon-1
    call greg_message(seve%e,rname,mess)
    ngon = mgon-1
  elseif (ngon.le.0) then
    call greg_message(seve%e,rname,'Number of vertices must be positive')
    error = .true.
    return
  endif
  poly%ngon = ngon
  !
  if (formx.eq.fmt_r4) then
    call r4tor8(memory(ipx),poly%xgon,ngon)
  elseif (formx.eq.fmt_r8) then
    call r8tor8(memory(ipx),poly%xgon,ngon)
  else
    call greg_message(seve%e,rname,'Unsupported variable type')
    error = .true.
    return
  endif
  !
  if (formy.eq.fmt_r4) then
    call r4tor8(memory(ipy),poly%ygon,ngon)
  elseif (formy.eq.fmt_r8) then
    call r8tor8(memory(ipy),poly%ygon,ngon)
  else
    call greg_message(seve%e,rname,'Unsupported variable type')
    error = .true.
    return
  endif
  !
end subroutine greg_poly_variable
!
subroutine greg_poly_cursor(rname,poly,error)
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>greg_poly_cursor
  use greg_types
  !---------------------------------------------------------------------
  ! @ public
  ! Define a polygon with the cursor
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: rname  ! Calling command name
  type(polygon_t),  intent(out)   :: poly   !
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=1) :: code
  real(kind=8) :: xa,ya,xlast(2),ylast(2)
  real(kind=4) :: xcurse,ycurse
  integer(kind=4) :: oldpen,newpen
  character(len=message_length) :: mess
  !
  if (.not.gtg_curs()) then
    call greg_message(seve%e,rname,'No cursor available')
    error = .true.
    return
  endif
  !
  poly%ngon = 0
  newpen = 3  ! i.e. blue (by default)
  oldpen = gr_spen(newpen)
  do while (poly%ngon.lt.mgon-1)
    call gr_curs(xa,ya,xcurse,ycurse,code)
    if (code.eq.'H') then
      write (*,'(A)') 'Type H for help '
      write (*,'(A)') '     E to exit '
      write (*,'(A)') '     Q to abort (quit)'
      write (*,'(A)') '     C to correct the last vertex'
      write (*,'(A)') '     D to delete the last vertex'
      write (*,'(A)') '     anything else to set a new vertex'
      write (*,'(A)') 'Mouse Button Actions:'
      write (*,'(A)') '     Left   - set new vertex'
      write (*,'(A)') '     Middle - delete last vertex'
      write (*,'(A)') '     Right  - exit'
      !
    elseif (code.eq.'Q') then
      call greg_message(seve%e,rname,'Aborting.')
      if (poly%ngon.ge.2) then
        call gtdls
      endif
      poly%ngon = 0
      error = .true.
      goto 99
      !
    elseif (code.eq.'C') then
      ! ngon unchanged
      poly%xgon(poly%ngon) = xa
      poly%ygon(poly%ngon) = ya
      !
      write(mess,100) 'VERTEX',poly%ngon,xa,ya,'(corrected)'
      call greg_message(seve%r,rname,mess)
      !
      call gtdls  ! Destroy the POLYGON segment...
      call gr_segm('POLYGON',error)  ! .. and recreate a new one
      if (error)  goto 99
      call gr8_connect(poly%ngon,poly%xgon,poly%ygon,0.d0,-1.d0)
      call gtview('Update')
      !
    elseif (code.eq.'D' .or. code.eq.'&') then
      write(mess,101) 'VERTEX',poly%ngon,'deleted'
      call greg_message(seve%r,rname,mess)
      !
      poly%ngon = poly%ngon-1
      if (poly%ngon.lt.0)  poly%ngon = 0
      !
      if (poly%ngon.ge.2) then
        call gtdls  ! Destroy the POLYGON segment...
        call gr_segm('POLYGON',error)  ! .. and recreate a new one
        if (error)  goto 99
        call gr8_connect(poly%ngon,poly%xgon,poly%ygon,0.d0,-1.d0)
        call gtview('Update')
      endif
      !
    elseif (code.eq.'E' .or. code.eq.'*') then
      ! Exit i.e. finalize the polygon
      if (poly%ngon.le.2) then
        call greg_message(seve%e,rname,'Polygon has less than 3 points')
        error = .true.
        goto 99
      endif
      !
      xlast(1) = poly%xgon(poly%ngon)
      xlast(2) = poly%xgon(1)
      ylast(1) = poly%ygon(poly%ngon)
      ylast(2) = poly%ygon(1)
      call gr8_connect(2,xlast,ylast,0.d0,-1.d0)
      call gtsegm_close(error)
      goto 99
      !
    else
      ! Add a new vertex
      poly%ngon = poly%ngon+1
      poly%xgon(poly%ngon) = xa
      poly%ygon(poly%ngon) = ya
      !
      write(mess,100) 'VERTEX',poly%ngon,xa,ya
      call greg_message(seve%r,rname,mess)
      !
      ! Store in the metacode and plot
      if (poly%ngon.lt.2)  cycle  ! Do loop
      if (poly%ngon.eq.2) then
        call gr_segm('POLYGON',error)
        if (error)  goto 99
      endif
      ! Add the new points:
      call gr8_connect(2,poly%xgon(poly%ngon-1),poly%ygon(poly%ngon-1),0.d0,-1.d0)
      ! Do not close the segment: just draw its current points
      call gtview('Append')
      !
    endif
  enddo
  call greg_message(seve%e,rname,'Too many vertices, exiting from cursor mode')
  !
99 newpen = gr_spen(oldpen)
  !
100 format(2x,A,' #',I0,': ',2(1pg10.3,1x),A)
101 format(2x,A,' #',I0,': ',A)
end subroutine greg_poly_cursor
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine greg_poly_parsename(line,iname,ivar,isfile,name,error)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>greg_poly_parsename
  use greg_types
  !---------------------------------------------------------------------
  ! @ public
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line
  integer(kind=4),  intent(in)    :: iname
  integer(kind=4),  intent(in)    :: ivar
  logical,          intent(out)   :: isfile
  character(len=*), intent(out)   :: name
  logical,          intent(inout) :: error
  !
  integer(kind=4) :: nc
  character(len=filename_length) :: chain
  !
  isfile = .false.
  if (sic_present(iname,1)) then
     call sic_ch(line,0,1,chain,nc,.true.,error)
     if (error) return
     if (.not.sic_present(ivar,0)) then
        isfile = .true.
        call sic_parse_file(chain,' ','.pol',name)
     else
        name = trim(chain)
     endif
  else
     name = ' '
  endif
  !
end subroutine greg_poly_parsename
!
subroutine greg_poly_load(rname,isfile,polyname,poly,error)
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>greg_poly_load
  use greg_types
  !---------------------------------------------------------------------
  ! @ public
  ! Load the polygon data into the poly structure
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: rname
  logical,          intent(in)    :: isfile
  character(len=*), intent(in)    :: polyname
  type(polygon_t),  intent(out)   :: poly ! *** JP in or inout?
  logical,          intent(inout) :: error
  !
  integer(kind=4) :: lun,ier
  !
  if (isfile) then
     ier = sic_getlun(lun)
     if (ier.ne.1) then
        error = .true.
        return
     endif
     ier = sic_open(lun,polyname,'OLD',.true.)
     if (ier.ne.0) then
        call greg_message(seve%e,rname,'Cannot open file '//polyname)
        call putios('E-POLYGON,  ',ier)
        error = .true.
        goto 100
     endif
  else
     lun = 0
  endif
  !
  ! Read polygon from file or from cursor
  call greg_poly_loadsub(rname,poly,lun,polyname,error)
  ! if (error) continue
  !
100 continue
  if (lun.ne.0) then
    ier = sic_close(lun)
    call sic_frelun(lun)
  endif
  !
end subroutine greg_poly_load
!
function greg_poly_isnull()
  use greg_poly
  !---------------------------------------------------------------------
  ! @ public
  ! Return .TRUE. if Greg polygon is not a polygon / not defined
  !---------------------------------------------------------------------
  logical :: greg_poly_isnull ! Function
  !
  greg_poly_isnull = gpoly%ngon.le.2
  !
end function greg_poly_isnull
!
subroutine greg_poly_get(poly)
  use greg_interfaces, except_this=>greg_poly_get
  use greg_poly
  use greg_types
  !---------------------------------------------------------------------
  ! @ public
  ! Return Greg internal polygon values copied input polygon
  !---------------------------------------------------------------------
  type(polygon_t), intent(out) :: poly
  !
  poly = gpoly
  !
end subroutine greg_poly_get
!
function greg_poly_inside(x0,y0,poly)
  use greg_interfaces, except_this=>greg_poly_inside
  use greg_types
  !---------------------------------------------------------------------
  ! @ public
  ! Find if a point is within a polygon.
  !
  ! This uses the Ray casting algorithm, counting how many times a ray
  ! starting from the point crosses the polygon boundaries. Note that
  ! there are critical conditions to be taken into account when the
  ! point is on a vertex or on a boundary or when the ray strikes
  ! through a vertex.
  ! References:
  !  https://en.wikipedia.org/wiki/Point_in_polygon
  !  https://rosettacode.org/wiki/Ray-casting_algorithm
  !---------------------------------------------------------------------
  logical :: greg_poly_inside ! Function value on return
  real(kind=8),    intent(in) :: x0,y0  ! Coordinate of point to test
  type(polygon_t), intent(in) :: poly   ! Polygon properties
  ! Local
  logical :: yin
  integer(kind=4) :: index,igon,jgon
  real(kind=8) :: slope,x,y,xx
  !
  ! Quick check
  if (x0.lt.poly%xgon1 .or. x0.gt.poly%xgon2 .or.  &
      y0.lt.poly%ygon1 .or. y0.gt.poly%ygon2) then
     greg_poly_inside = .false.
     return
  endif
  greg_poly_inside = .true.
  !
  ! Count intersection
  x = x0
  y = y0
  index = 0
  do igon=1,poly%ngon
     if (x0.eq.poly%xgon(igon) .and. y0.eq.poly%ygon(igon)) then
        ! On a vertex
        return  ! Inside
     endif
     ! Select segment igon to jgon
     if (igon.eq.poly%ngon) then
       jgon = 1       ! Close the polygon
     else
       jgon = igon+1  ! Next summit
     endif
     if (y0.eq.poly%ygon(igon) .or. y0.eq.poly%ygon(jgon)) then
      ! To avoid the "ray on vertex" problem, the point is moved upward
      ! of a small quantity. Otherwise it would always be considered to
      ! cross the 2 segments and might mess the intersection count.
       y = y0+poly%yeps
     else
       y = y0
     endif
     ! Check Y range
     if (y.le.poly%ygon(igon) .and. y.ge.poly%ygon(jgon)) then
        yin = .true.
     elseif (y.ge.poly%ygon(igon) .and. y.le.poly%ygon(jgon)) then
        yin = .true.
     else
        yin = .false.
     endif
     ! If Y is OK, check X
     if (yin) then
        if (poly%dxgon(igon).ne.0) then
           ! Polygon side is normal
           slope = poly%dygon(igon)/poly%dxgon(igon)
           if (slope.ne.0d0) then
              ! Lines intersect
              xx = (y-poly%ygon(igon))/slope + poly%xgon(igon)
              if (xx.lt.x) then  ! Cross the boundary
                 index = index+1
              elseif (xx.eq.x) then  ! On the boundary
                 return  ! Inside
              else  ! Does not cross the boundary
                 continue
              endif
           else
              ! Lines have same slope (i.e., horizontal)
              if (x.ge.poly%xgon(igon) .and. x.le.poly%xgon(jgon)) then
                 ! On edge
                 return  ! Inside
              elseif (x.le.poly%xgon(igon) .and. x.ge.poly%xgon(jgon)) then
                 ! On edge
                 return  ! Inside
              endif
           endif
        else
           ! Polygon side is vertical
           if (poly%xgon(igon).lt.x) then  ! Cross the boundary
              index = index+1
           elseif (poly%xgon(igon).eq.x) then  ! On the boundary
              return  ! Inside
           endif
        endif
     endif
  enddo ! igon
  greg_poly_inside = mod(index,2).eq.1
end function greg_poly_inside
!
subroutine greg_poly2mask(blank,inside,poly,nx,ny,xconv,yconv,r2d)
  use greg_interfaces, except_this=>greg_poly2mask
  use greg_types
  !---------------------------------------------------------------------
  ! @ public
  ! Mask part of a 2D array using a given boundary
  !---------------------------------------------------------------------
  real(kind=4),         intent(in)    :: blank ! Blanking value
  logical,              intent(in)    :: inside
  type(polygon_t),      intent(in)    :: poly
  integer(kind=4),      intent(in)    :: nx
  integer(kind=4),      intent(in)    :: ny
  real(kind=8), target, intent(in)    :: xconv(3)
  real(kind=8), target, intent(in)    :: yconv(3)
  real(kind=4),         intent(inout) :: r2d(nx,ny)
  ! Local
  real(kind=8) :: x,y
  real(kind=8), pointer :: xval,xinc,xref
  real(kind=8), pointer :: yval,yinc,yref
  integer(kind=4) :: ix,ixmin,ixmax
  integer(kind=4) :: iy,iymin,iymax
  !
  ! Avoid exploring all the array by finding ixmin,ixmax,iymin,iymax
  xref => xconv(1)
  xval => xconv(2)
  xinc => xconv(3)
  yref => yconv(1)
  yval => yconv(2)
  yinc => yconv(3)
  if (xinc.gt.0.) then
    ixmin = max (1, int((poly%xgon1-xval)/xinc+xref) )
    ixmax = min (nx,int((poly%xgon2-xval)/xinc+xref)+1 )
  else
    ixmin = max (1, int((poly%xgon2-xval)/xinc+xref) )
    ixmax = min (nx,int((poly%xgon1-xval)/xinc+xref)+1 )
  endif
  if (yinc.gt.0.) then
    iymin = max (1, int((poly%ygon1-yval)/yinc+yref) )
    iymax = min (ny,int((poly%ygon2-yval)/yinc+yref)+1 )
  else
    iymin = max (1, int((poly%ygon2-yval)/yinc+yref) )
    iymax = min (ny,int((poly%ygon1-yval)/yinc+yref)+1 )
  endif
  !
  if (.not.inside) then
    ! Mask the outside
    do iy=1,ny
      do ix=1,nx
        if (ix.lt.ixmin) then
          r2d(ix,iy) = blank
        elseif (ix.gt.ixmax) then
          r2d(ix,iy) = blank
        elseif (iy.gt.iymax) then
          r2d(ix,iy) = blank
        elseif (iy.lt.iymin) then
          r2d(ix,iy) = blank
        else
          x = (ix-xref)*xinc+xval
          y = (iy-yref)*yinc+yval
          if (.not.greg_poly_inside(x,y,poly)) then
            r2d(ix,iy) = blank
          endif
        endif
      enddo ! ix
    enddo ! iy
  else
    ! Mask the inside
    do iy=iymin,iymax
      do ix=ixmin,ixmax
        x = (ix-xref)*xinc+xval
        y = (iy-yref)*yinc+yval
        if (greg_poly_inside(x,y,poly)) then
          r2d(ix,iy) = blank
        endif
      enddo ! ix
    enddo ! iy
  endif
end subroutine greg_poly2mask
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
