subroutine vstrin(nchar,string,drawit,slengt,xp,yp,angle,ifont,size,  &
  doclip,gpoly_noclip,gpoly_clip)
  use gildas_def
  use phys_const
  use gchar_interfaces, except_this=>vstrin
  use gchar_variables
  !---------------------------------------------------------------------
  ! @ public
  !
  !	Interprets a string of character with escape sequences
  !	\P or \\P  and plots out the characters according to
  !	current font quality SIMPLEX or DUPLEX
  !
  !	If the shareable common is not initialised, VSTRING attempts
  !	to initialise it using VSINIT. Just do not forget to assign
  !	properly the CHAR_FONT logical name to your GREGFONT.BIN file
  !	when you run a non-shareable image.
  !
  !	The reference point is located at the left of the string, and
  !	at middle in height. To append a second string, just move the
  !	reference point as following before calling again VSTRING :
  !		...
  !		CO = COS(ANGLE*PI/180.)
  !		SI = SIN(ANGLE*PI/180.)
  !		CALL VSTRING (..., SLENGT, XP, YP, ANGLE, ...)
  !		XP = XP + CO*SLENGT
  !		YP = YP + SI*SLENGT
  !		CALL VSTRING (..., SLENGT, XP, YP, ANGLE, ...)
  !
  !---------------------------------------------------------------------
  integer(kind=4),  intent(in)  :: nchar         ! String length
  character(len=*), intent(in)  :: string        ! String to be drawn
  logical,          intent(in)  :: drawit        ! Draw string or compute length ?
  real(kind=4),     intent(out) :: slengt        ! Length of string in centimeters
  real(kind=4),     intent(in)  :: xp            ! Abscissa of reference point
  real(kind=4),     intent(in)  :: yp            ! Ordinate of reference point
  real(kind=4),     intent(in)  :: angle         ! Angle (Degrees)
  integer(kind=4),  intent(in)  :: ifont         ! Quality 0=Simplex 1=Duplex
  real(kind=4),     intent(in)  :: size          ! Character size
  logical,          intent(in)  :: doclip        ! Clip with current Greg box?
  external                      :: gpoly_noclip  !
  external                      :: gpoly_clip    !
  ! Interfaces
  interface
    subroutine gpoly_noclip(n,vx,vy,error)
      integer, intent(in)    :: n      ! Number of points
      real*4,  intent(in)    :: vx(n)  ! Array of abscissae
      real*4,  intent(in)    :: vy(n)  ! Array of ordinates
      logical, intent(inout) :: error  ! Logical error flag
    end subroutine gpoly_noclip
    subroutine gpoly_clip(nq,xq,yq)
      use gildas_def
      integer(kind=size_length), intent(in) :: nq     ! Number of points
      real(kind=4),              intent(in) :: xq(*)  ! Plot X coordinates
      real(kind=4),              intent(in) :: yq(*)  ! Plot Y coordinates
    end subroutine gpoly_clip
  end interface
  ! Local
  integer(kind=4), parameter :: backsl=92
  logical :: relo, done
  real(kind=4) :: slant, supfra
  integer(kind=4) :: jchar,i,j,k, ix, iy, ix0
  integer(kind=4) :: isuper,ioffse,italic,ibase,icom
  integer(kind=4) :: jsuper,joffse,jtalic,jbase
  logical :: error
  !
  integer(kind=4) :: npoints
  integer(kind=size_length) :: nsl
  integer(kind=4), parameter :: mpoints=50
  real(kind=4) :: xpoints(mpoints),ypoints(mpoints)
  !
  real(kind=4) :: sufact ,sushif
  real(kind=4) :: tufact,tushif
  real(kind=4) :: x,y,xc,yc,x0,y0,co,si,xa,const
  integer(kind=1) :: abyte
  ! Data
  data slant /0.2/, supfra /0.7/, done /.false./
  save done
  !
  ! Check if the common has been initialised
  if (.not.done) then
    call vsinit (vstrsh1,nkpage)
    done = .true.
  endif
  !
  error = .false.
  !
  ! Set up constants
  !
  co = cos(angle*pi/180.)
  si = sin(angle*pi/180.)
  x0 = xp
  y0 = yp
  slengt = 0
  icom = 0
  ibase  = 300*ifont
  jbase  = 300*ifont
  italic = 0
  jtalic = 0
  ioffse = 0
  joffse = 0
  isuper = 0
  jsuper = 0
  sufact = 1.
  sushif = 0.
  tufact = 1.
  tushif = 0.
  !
  ! Pixel to centimeters conversion
  const = size/35.
  !-----------------------------------------------------------------------
  !
  ! 	\\X - set mode X
  ! 	\X  - set mode X for next chararacter only
  !	\1  - set font Simplex
  !	\2  - set font Duplex
  !	\N  - return to default character set
  ! 	\R  - roman font
  ! 	\G  - greek font
  ! 	\S  - script font
  ! 	\I  - toggle italics
  ! 	\U  - superscript
  ! 	\D  - subscript
  ! 	\B  - backspace
  !-----------------------------------------------------------------------
  !
  do j=1,nchar
    !
    abyte = ichar(string(j:j))
    if (abyte.eq.backsl) then
      icom = icom + 1
      cycle                    ! J
    elseif (abyte.lt.32) then
      abyte = ichar(' ')
    endif
    !
    ! Decode control sequence
    if (icom.gt.0) then
      if (abyte.eq.ichar('N').or.abyte.eq.ichar('n')) then
        ibase  = 300*ifont
      elseif (abyte.eq.ichar('1')) then
        ibase  = 0
      elseif (abyte.eq.ichar('2')) then
        ibase  = 300
      elseif (abyte.eq.ichar('R').or.abyte.eq.ichar('r')) then
        ioffse = 0
      elseif (abyte.eq.ichar('G').or.abyte.eq.ichar('g')) then
        ioffse = 100
      elseif (abyte.eq.ichar('S').or.abyte.eq.ichar('s')) then
        ioffse = 200
      elseif (abyte.eq.ichar('I').or.abyte.eq.ichar('i')) then
        italic = 1 - italic
      elseif (abyte.eq.ichar('U').or.abyte.eq.ichar('u')) then
        isuper = isuper + 1
        sushif = sushif + 16.*sufact
        sufact = supfra**iabs(isuper)
      elseif (abyte.eq.ichar('D').or.abyte.eq.ichar('d')) then
        isuper = isuper - 1
        sufact = supfra**iabs(isuper)
        sushif = sushif - 16.*sufact
      elseif (abyte.eq.ichar('B').or.abyte.eq.ichar('b')) then
        slengt = slengt - xa
        x0 = x0 - co*xa
        y0 = y0 - si*xa
      endif
      !
      if (icom.gt.1) then
        jbase = ibase
        jtalic = italic
        joffse = ioffse
        jsuper = isuper
        tufact = sufact
        tushif = sushif
      endif
      icom = 0
      cycle                    ! J
    endif
    !
    ! Address the correct character into the font
    jchar = abyte - 31 + ioffse + ibase
    !
    ! Check if Draw or evaluate length only
    if (drawit) then
      !
      ! Now draw the character
      relo = .true.
      npoints = 0
      i  = pointe(jchar)
      ix0 = ladj(jchar)
      do k = 0,nstrok(jchar)-1
        ix = font(i)
        iy = font(i+1)
        if (ix.eq.-64) then
          relo = .true.
        else
          x = ix - ix0
          if (italic.eq.1) x = x + slant*(iy+9)
          !
          ! Convert to centimeter size
          x = const * sufact * x
          y = const * (iy * sufact + sushif)
          xc = co*x - si*y + x0
          yc = si*x + co*y + y0
          if (relo) then
            relo = .false.
            if (doclip) then
              nsl = npoints
              call gpoly_clip(nsl,xpoints,ypoints)
            else
              call gpoly_noclip(npoints,xpoints,ypoints,error)
              if (error)  return
            endif
            npoints = 0
          endif
          npoints = npoints+1
          xpoints(npoints) = xc
          ypoints(npoints) = yc
        endif
        i = i+2
      enddo
      !
      ! Flush last polyline of current character
      if (doclip) then
        nsl = npoints
        call gpoly_clip(nsl,xpoints,ypoints)
      else
        call gpoly_noclip(npoints,xpoints,ypoints,error)
        if (error)  return
      endif
      !
    endif  ! Drawing or not the character
    !
    ! Compute spaced used by the character
    xa = const * (radj(jchar)-ladj(jchar)) * sufact
    slengt = slengt + xa
    x0 = x0 + co*xa
    y0 = y0 + si*xa
    italic = jtalic
    ioffse = joffse
    ibase  = jbase
    isuper = jsuper
    sufact = tufact
    sushif = tushif
    !
  enddo  ! J (next character)
  !
end subroutine vstrin
!
subroutine vsconv(ficode,sycode)
  use gchar_interfaces, except_this=>vsconv
  use gchar_variables
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  character(len=*) :: ficode        !
  character(len=*) :: sycode        !
  !
  if (ficode.eq.'IEEE' .or. ficode.eq.'VAX_') then
    ! VAX_ and swapped IEEE I2 and I4 are identical
    if (sycode.eq.'EEEI') then
      call iei2ei (nstrok,nstrok,nkchar)   !     & NSTROK, ! INTEGER*2
      call iei2ei (ladj,ladj,nkchar)   !     & LADJ,   ! INTEGER*2
      call iei2ei (radj,radj,nkchar)   !     & RADJ,   ! INTEGER*2
      call iei4ei (pointe,pointe,nkchar)   !     & POINTE, ! INTEGER*4
    endif
  else
    ! FICODE = 'EEEI',  SYCODE = 'IEEE' or 'VAX_'
    call eii2ie (nstrok,nstrok,nkchar) !     & NSTROK, ! INTEGER*2
    call eii2ie (ladj,ladj,nkchar) !     & LADJ,   ! INTEGER*2
    call eii2ie (radj,radj,nkchar) !     & RADJ,   ! INTEGER*2
    call eii4ie (pointe,pointe,nkchar) !     & POINTE, ! INTEGER*4
  endif
  ! FONT is a Byte array, and does not require conversion
end subroutine vsconv
