subroutine ellipse(line,error)
  use phys_const
  use gbl_constant
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>ellipse
  use greg_kernel
  use greg_pen
  use greg_types
  use greg_wcs
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for command:
  !   ELLIPSE Major Minor PA
  ! 1  /BOX  X Y
  ! 2  /USER X Y
  ! 3  /ARC THETA1 THETA2
  ! 4  /FILL [Icolor]
  ! 5  /HATCH [Ipen] [Angle] [Separ] [Phase]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='ELLIPSE'
  logical :: arc,box,user,abso
  integer(kind=4) :: nc,icol_old,ipen_old
  type(polygon_drawing_t) :: drawing
  real(kind=8) :: uscale
  integer(kind=4) :: usunit
  character(len=12) :: ctype(5),name,dummy
  ! Data: order is essential here
  data ctype/'SECONDS','MINUTES','DEGREES','RADIANS','ABSOLUTE'/
  !
  ! Options
  user = sic_present(2,0)
  abso = sic_present(2,3)
  box  = sic_present(1,0)
  arc  = sic_present(3,0)
  !
  ! /FILL and /HATCH options
  call inqcol(icol_old)
  call inqpen(ipen_old)
  call parse_polygon_drawing(rname,line,4,5,drawing,error)
  if (error)  return
  !
  if (user .and. box) then
    call greg_message(seve%e,rname,'Conflicting options /BOX and /USER')
    goto 99
  endif
  !
  ! Angle Unit
  usunit = u_angle
  if (abso) then
    if (gproj%type.eq.p_none) then
      call greg_message(seve%w,rname,'User unit forbidden when no projection')
      goto 99
    else
      call sic_ke (line,2,3,dummy,nc,.true.,error)
      if (error) goto 99
      call sic_ambigs(rname,dummy,name,usunit,ctype,5,error)
      if (error) goto 99
    endif
  endif
  !
  uscale = 1.d0
  if (usunit.eq.u_second) then
    uscale = pi/180.d0/3600.d0
  elseif (usunit.eq.u_minute) then
    uscale = pi/180.d0/60.d0
  elseif (usunit.eq.u_degree) then
    uscale = pi/180.d0
  else
    uscale = 1.d0
  endif
  !
  ! Pen or color to be used. Note: color-filling and hatch-filling can not
  ! be done at the same time, mostly because this would imply to create
  ! 2 segments with 2 colors
  if (penupd)  call setpen(cpen)
  if (drawing%filled) then
    call setcol(drawing%fcolor)
  elseif (drawing%hatched) then
    call setpen(drawing%hpen)
  endif
  !
  call gtsegm(rname,error)
  !
  if (.not.user .or. usunit.eq.5) then
    ! No array mode if /BOX or /USER x y ABSOLUTE
    call ellipse_scalar(line,box,user,abso,usunit,uscale,arc,drawing,error)
  else
    ! /USER support arrays
    call ellipse_array(line,uscale,arc,drawing,error)
  endif
  if (error)  goto 99
  !
  call gtsegm_close(error)
  ! Reset pen *after* closing the segment
  call setpen(ipen_old)
  call setcol(icol_old)
  return
  !
99 continue
  !
  error = .false.
  call gtsegm_close(error)
  ! Reset pen *after* closing the segment
  call setpen(ipen_old)
  call setcol(icol_old)
  error = .true.
end subroutine ellipse
!
subroutine ellipse_scalar(line,box,user,abso,usunit,uscale,arc,drawing,error)
  use phys_const
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>ellipse_scalar
  use greg_kernel
  use greg_types
  use greg_wcs
  !---------------------------------------------------------------------
  ! @ private
  ! Draw a single ellipse, command line arguments must be scalar
  !---------------------------------------------------------------------
  character(len=*),        intent(in)    :: line     ! Input command line
  logical,                 intent(in)    :: box      !
  logical,                 intent(in)    :: user     ! /USER
  logical,                 intent(in)    :: abso     ! /USER ABSO
  integer(kind=4),         intent(in)    :: usunit   !
  real(kind=8),            intent(in)    :: uscale   !
  logical,                 intent(in)    :: arc      ! /ARC
  type(polygon_drawing_t), intent(in)    :: drawing  ! Drawing description
  logical,                 intent(inout) :: error    ! Logical error flag
  ! Local
  integer(kind=4) :: istart,length
  real(kind=4) :: amin,amaj,pa,xpos,ypos
  real(kind=8) :: xus,yus,theta1,theta2,sux,suy
  !
  ! Arguments
  call sic_r4 (line,0,1,amaj,.true.,error)
  if (error) return
  amin = amaj
  call sic_r4 (line,0,2,amin,.false.,error)
  if (error) return
  pa = 0.
  call sic_r4 (line,0,3,pa,.false.,error)
  if (error) return
  ! PA MUST be in degrees , trigonometric , not in radians. I report the con-
  ! version to radians in the subroutine sub_ellipse, since it will then
  ! be compatible with the array mode
  !
  if (box) then
    call sic_r4 (line,1,2,ypos,.true.,error)
    if (error) return
    call sic_r4 (line,1,1,xpos,.true.,error)
    if (error) return
    if (axis_xlog) then
      xus = exp((xpos)/gux + lux)
    else
      xus = (xpos)/gux + gux1
    endif
    if (axis_ylog) then
      yus = exp((ypos)/guy + luy)
    else
      yus = (ypos)/guy + guy1
    endif
    !
    ! What about /BOX with U_ANGLE not radian ?
    xus = xus/uscale
    yus = yus/uscale
  elseif (abso) then
    ! USER with ABSOLUTE
    if (usunit.eq.5) then
      istart = sic_start(2,1)
      length = sic_len(2,1)
      call sic_sexa(line(istart:),length,xus,error)
      if (error) return
      if (i_system.eq.type_eq .or. i_system.eq.type_ic) then
        xus = xus*pi/12.0d0
      else
        xus = xus*pi/180.0d0
      endif
      istart = sic_start(2,2)
      length = sic_len(2,2)
      call sic_sexa(line(istart:),length,yus,error)
      if (error) return
      yus = yus*pi/180.0d0
      sux = xus
      suy = yus
      call abs_to_rel(gproj,sux,suy,xus,yus,1)
    else
      ! Unreachable code ...
      call sic_r8 (line,2,2,yus,.true.,error)
      if (error) return
      call sic_r8 (line,2,1,xus,.true.,error)
      if (error) return
    endif
  elseif (user) then
    ! Unreachable code ...
    call sic_r8 (line,2,2,yus,.true.,error)
    if (error) return
    call sic_r8 (line,2,1,xus,.true.,error)
    if (error) return
  else
    !
    ! Current pen position
    if (axis_xlog) then
      xus = exp((xp-gx1)/gux + lux)
    else
      xus = (xp-gx1)/gux + gux1
    endif
    if (axis_ylog) then
      yus = exp((yp-gy1)/guy + luy)
    else
      yus = (yp-gy1)/guy + guy1
    endif
    !
    ! What happens if U_ANGLE is not radian ?
    xus = xus/uscale
    yus = yus/uscale
  endif
  !
  ! /ARC option
  if (arc) then
    call sic_r8 (line,3,2,theta2,.true.,error)
    if (error) return
    call sic_r8 (line,3,1,theta1,.true.,error)
    if (error) return
  endif
  call sub_ellipse(amaj,amin,pa,arc,theta1,theta2,xus,yus,drawing,uscale,error)
  !
end subroutine ellipse_scalar
!
subroutine ellipse_array(line,uscale,arc,drawing,error)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>ellipse_array
  use gildas_def
  use gbl_format
  use gbl_message
  use sic_types
  use greg_types
  !---------------------------------------------------------------------
  ! @ private
  !  Draw one or several ellipses, command line arguments can be scalar
  ! or array
  !---------------------------------------------------------------------
  character(len=*),        intent(in)    :: line     ! Input command line
  real(kind=8),            intent(in)    :: uscale   !
  logical,                 intent(in)    :: arc      ! /ARC
  type(polygon_drawing_t), intent(in)    :: drawing  ! Drawing description
  logical,                 intent(inout) :: error    ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='ELLIPSE'
  type(sic_descriptor_t) :: inca1,inca2,inca3,inca4,inca5,default
  integer(kind=index_length) :: np(5),nmaj,nmin,npa,npx,npy,ntot,i
  integer(kind=4) :: kmaj,kmin,kpa,kpx,kpy
  integer(kind=address_length) :: imaj,imin,ipa,ipx,ipy
  real(kind=4) :: pa
  real(kind=8) :: theta1,theta2
  !
  ntot = 0
  default%readonly = .false.
  default%ndim = 0
  default%dims(:) = 0
  default%addr = 0
  default%size = 0
  default%status = 0
  !
  ! MAJ MIN and ORI must be R*4, X and Y positions must be R*8.
  ! That is not necessary what the user got. So we use SIC_INCARNATE
  default%type = fmt_r4
  call sic_inca (line,0,1,inca1,default,.true.,error)
  if (error) return
  imaj = gag_pointer(inca1%addr,memory)
  nmaj = inca1%dims(1)
  if (nmaj.le.1) then
    kmaj = 0
  else
    ntot = nmaj
    kmaj = 1
  endif
  !
  ! Min Axis, default INCA1
  call sic_inca (line,0,2,inca2,inca1,.false.,error)
  if (error) then
    call sic_volatile(inca1)
    return
  endif
  imin = gag_pointer(inca2%addr,memory)
  nmin = inca2%dims(1)
  if (nmin.gt.1) then
    if (ntot.eq.0) ntot = nmin
    kmin = 1
  else
    kmin = 0
  endif
  !
  ! PA: default 0.0
  pa = 0.0
  default%addr = locwrd(pa)
  default%ndim = 0
  call sic_inca (line,0,3,inca3,default,.false.,error)
  if (error) then
    if (sic_notsamedesc(inca1,inca2)) call sic_volatile(inca2)
    call sic_volatile(inca1)
    return
  endif
  ipa = gag_pointer(inca3%addr,memory)
  npa = inca3%dims(1)
  if (npa.gt.1) then
    if (ntot.eq.0) ntot = npa
    kpa = 1
  else
    kpa = 0
  endif
  !
  ! X
  default%type = fmt_r8
  call sic_inca (line,2,1,inca4,default,.true.,error)
  if (error) then
    call sic_volatile(inca3)
    if (sic_notsamedesc(inca1,inca2)) call sic_volatile(inca2)
    call sic_volatile(inca1)
    return
  endif
  if (error) return
  npx = inca4%dims(1)
  if (npx.gt.1) then
    if (ntot.eq.0) ntot = npx
    kpx = 2
  else
    kpx = 0
  endif
  ipx = gag_pointer(inca4%addr,memory)
  ! Y
  default%type = fmt_r8
  if (error) then
    call sic_volatile(inca4)
    call sic_volatile(inca3)
    if (sic_notsamedesc(inca1,inca2)) call sic_volatile(inca2)
    call sic_volatile(inca1)
    return
  endif
  call sic_inca (line,2,2,inca5,default,.true.,error)
  if (error) return
  npy = inca5%dims(1)
  if (npy.gt.1) then
    if (ntot.eq.0) ntot = npy
    kpy = 2
  else
    kpy = 0
  endif
  ipy = gag_pointer(inca5%addr,memory)
  !
  ! /ARC option to be treated properly some time
  if (arc) then
    call sic_r8 (line,3,2,theta2,.true.,error)
    call sic_r8 (line,3,1,theta1,.true.,error)
  endif
  !
  ! Check array compatibilities
  np = (/nmaj,nmin,npa,npx,npy/)
  do i=1,5
    if (np(i).gt.1 .and. np(i).ne.ntot) then
      call greg_message(seve%e,rname,'Arrays have incompatible sizes')
      error = .true.
    endif
  enddo
  ntot = max(ntot,1)         ! Scalar have size 0
  !
  do i=1,ntot
    if (error)  exit
    call sub_ellipse(memory(imaj),memory(imin),memory(ipa),arc,theta1,  &
      theta2,memory(ipx),memory(ipy),drawing,uscale,error)
    imaj = imaj+kmaj
    imin = imin+kmin
    ipa  = ipa+kpa
    ipx  = ipx+kpx
    ipy  = ipy+kpx
  enddo
  !
  ! Volatilize the incarnations
  call sic_volatile(inca5)
  call sic_volatile(inca4)
  call sic_volatile(inca3)
  if (sic_notsamedesc(inca1,inca2)) call sic_volatile(inca2)
  call sic_volatile(inca1)
  !
end subroutine ellipse_array
!
subroutine sub_ellipse(amaj,amin,pa,arc,thet1,thet2,xus,yus,drawing,scale,error)
  use gildas_def
  use phys_const
  use greg_interfaces
  use greg_kernel
  use greg_types
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !---------------------------------------------------------------------
  real(kind=4),            intent(in)    :: amaj     ! Major axis
  real(kind=4),            intent(in)    :: amin     ! Minor axis
  real(kind=4),            intent(in)    :: pa       ! Position angle
  logical,                 intent(in)    :: arc      ! Arc or full ellipse?
  real(kind=8),            intent(in)    :: thet1    ! If arc, starting angle
  real(kind=8),            intent(in)    :: thet2    ! If arc, ending angle
  real(kind=8),            intent(in)    :: xus      ! Ellipse X center
  real(kind=8),            intent(in)    :: yus      ! Ellipse Y center
  type(polygon_drawing_t), intent(in)    :: drawing  ! Drawing description
  real(kind=8),            intent(in)    :: scale    ! Conversion factor from Current Unit to User Unit
  logical,                 intent(inout) :: error    ! Logical error flag
  ! Global
  external :: gdraw
  ! Local
  real(kind=4) :: ppa
  integer(kind=size_length) :: nxy
  integer(kind=4), parameter :: mxy=51
  character(len=1) :: variable
  character(len=12) :: algorithm
  logical :: periodic
  real(kind=8) :: theta1,theta2,x(mxy),y(mxy),z(mxy)
  real(kind=4) :: cosa,sina,rx,ry
  integer(kind=4) :: i
  ! Data
  data algorithm /'CUBIC_SPLINE'/, variable /'Z'/
  !
  ! PA must be in degrees at subroutine call (same as THETA*). converted
  ! internally to radians
  ppa = pa*rad_per_deg
  !
  if (drawing%filled .or. drawing%hatched) then
    nxy = mxy
  else
    nxy = 21
  endif
  !
  cosa = cos(ppa)
  sina = sin(ppa)
  if (arc) then
    theta1 = thet1*rad_per_deg
    theta2 = thet2*rad_per_deg
    do while(theta2.lt.theta1)
      theta2 = theta2+2.d0*pi
    enddo
    if (drawing%filled .or. drawing%hatched) then
      x(1) = xus
      y(1) = yus
      do i=2,nxy-1
        z(i) = theta1 + (theta2-theta1)*(i-2.)/(nxy-3.)
        rx = amaj*cos(z(i))
        ry = amin*sin(z(i))
        x(i) = rx*cosa - ry*sina + xus
        y(i) = rx*sina + ry*cosa + yus
      enddo
      x(nxy) = xus
      y(nxy) = yus
    else
      do i=1,nxy
        z(i) = theta1 + (theta2-theta1)*(i-1.)/(nxy-1.)
        rx = amaj*cos(z(i))
        ry = amin*sin(z(i))
        x(i) = rx*cosa - ry*sina + xus
        y(i) = rx*sina + ry*cosa + yus
      enddo
    endif
    periodic = .false.
  else
    do i=1,nxy
      z(i) = 2.*pi*(i-1.)/(nxy-1.)
      rx = amaj*cos(z(i))
      ry = amin*sin(z(i))
      x(i) = rx*cosa - ry*sina + xus
      y(i) = rx*sina + ry*cosa + yus
    enddo
    x(nxy) = x(1)
    y(nxy) = y(1)
    periodic = .true.
  endif
  !
  ! Plot the curve using Spline
  x(1:nxy) = x(1:nxy)*scale
  y(1:nxy) = y(1:nxy)*scale
  !
  if (drawing%hatched) then
    call gr8_hatch('ELLIPSE',nxy,x,y,  &
                   drawing%hangle,drawing%hsepar,drawing%hphase,error)
  elseif (drawing%filled) then
    call gr8_ufill (nxy,x,y)
  else
    call plcurv (nxy,x,y,z,accurd,algorithm,variable,periodic,grelocate,  &
      gdraw,error)
  endif
  x(1) = xus*scale
  y(1) = yus*scale
  call relocate (x(1),y(1))
end subroutine sub_ellipse
