subroutine gwrite(val,x,y)
  use greg_interfaces, except_this=>gwrite
  use greg_kernel
  !---------------------------------------------------------------------
  ! @ private-mandatory (because symbol is used elsewhere)
  ! GREG	Internal routine
  !	This subroutine writes the value VAL at location X,Y in User
  ! 	Coordinates. VAL is encoded in shortest format.
  ! Arguments :
  !	VAL	R*4	Value to be encoded
  !	X	R*4	X coordinate
  !	Y	R*4	Y coordinate
  !---------------------------------------------------------------------
  real*4 :: val                     !
  real*4 :: x                       !
  real*4 :: y                       !
  ! Local
  character(len=24) :: chain
  character(len=20) :: string
  !
  integer :: nchar
  character(len=1), parameter :: backslash=char(92)
  !
  call conecd (val,string,nchar)
  call grelocate(y,x)
  nchar = nchar+3
  chain = backslash//backslash//'1'//string
  call putlabel(nchar,chain,5,tangle,.false.)
end subroutine gwrite
!
subroutine conecd (arg,string,ns)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>conecd
  !---------------------------------------------------------------------
  ! @ private
  ! GREG	Internal routine
  !	Encode the ARG value in the string STRING in the shortest
  !	possible format
  ! Arguments :
  !	ARG	R*4	Value to be encoded
  !	STRING	C*(*)	String to receive the coded value
  !	NS	I	Length of string
  ! Subroutines :
  !	(SIC)
  !---------------------------------------------------------------------
  real :: arg                       !
  character(len=*) :: string        !
  integer :: ns                     !
  ! Local
  character(len=1), parameter :: dot='.'
  character(len=2) :: buf1, buf2
  character(len=3) :: fspec
  character(len=20) :: fmt
  logical :: llfixe
  !
  integer :: nfig,nfield,iexpo,ndec,nchar,nplace
  real :: value,expo
  !
  nfig = 3
  nfield = 10
  !
  value = abs(arg)
  if (value.eq.0) then
    string='0.0'
    ns=1
    return
  elseif (value.lt.1e6.and.value.gt.1e-4) then
    expo = alog10(value)
    iexpo = ifix(expo)
    if (expo.lt.0) iexpo = iexpo - 1
    ndec = max(nfig-iexpo-1,0)
    nchar = ndec + 2 + max(iexpo+1,0)
    fspec = '0PF'
    llfixe=.true.
  else
    ndec = nfig - 1
    nchar = nfig + 6
    fspec = '1PE'
    llfixe=.false.
  endif
  nplace = max(nchar,nfield)
  write(buf1,1000) nplace
  write(buf2,1000) ndec
  fmt = '('//fspec//buf1//dot//buf2//')'
  write(string,fmt) arg
  ns = len(string)
  call sic_blanc(string,ns)
  !
  ! Fixed Format: Strip trailing zeroes and decimal point if needed
  if (llfixe) then
    do while (string(ns:ns).eq.'0')
      ns=ns-1
    enddo
    if (string(ns:ns).eq.dot) ns=ns-1
  endif
1000 format(i2)
end subroutine conecd
