	subroutine symbol( xin, yin, ht, strin, ang, nchin)
	real               xin, yin, ht,        ang
	integer*4                        strin(256),  nchin
C
C   Symbol subroutine conforming to
C	"Programming CalComp Electromechanical Plotters", 1976
C   For PostScript printers, using Adobe Courier font and font metrics
C
C   Rex Sanders, USGS, 3/87
C

	common /cqpbnf/ xold, yold, fac, ires
	save   /cqpbnf/
	real            xold, yold, fac
	integer                          ires

	real	x,	y,	dum1,	dum2
	real	cosang,	sinang
	integer	nch,	nfwd,	i,	ic,	intang

C		cfudge - Courier font fudge factor to get proper height
	real	cfudge
	save	cfudge

C		xoff - X offset for centered chars
C		yoff - Y offset for centered chars
	real	xoff(32:126),	yoff(32:126)
	save	xoff        ,	yoff

C		ctable - centered char conversion table
	integer	ctable(0:127)
	save	ctable

	character*1024	cstr
	integer*4	istr(256)
	equivalence	(cstr, istr)


C		htold - saved previous height
	real	htold
	save	htold
	data	htold /0.0/

	data	cfudge /1.66666666/
C
C   Offsets for centered symbols - derived from Adobe Courier.AFM file
C
	data xoff(32), yoff(32) /-0.0000, -0.0000/
	data xoff(33), yoff(33) /-0.3000, -0.3170/
	data xoff(34), yoff(34) /-0.3000, -0.4585/
	data xoff(35), yoff(35) /-0.3000, -0.2915/
	data xoff(36), yoff(36) /-0.3000, -0.2810/
	data xoff(37), yoff(37) /-0.3000, -0.3020/
	data xoff(38), yoff(38) /-0.2915, -0.2525/
	data xoff(39), yoff(39) /-0.2375, -0.4585/
	data xoff(40), yoff(40) /-0.3760, -0.2395/
	data xoff(41), yoff(41) /-0.2290, -0.2395/
	data xoff(42), yoff(42) /-0.3000, -0.4170/
	data xoff(43), yoff(43) /-0.3000, -0.2810/
	data xoff(44), yoff(44) /-0.2375, -0.0000/
	data xoff(45), yoff(45) /-0.3000, -0.2810/
	data xoff(46), yoff(46) /-0.3000, -0.0500/
	data xoff(47), yoff(47) /-0.3000, -0.2915/
	data xoff(48), yoff(48) /-0.3000, -0.3020/
	data xoff(49), yoff(49) /-0.3000, -0.3020/
	data xoff(50), yoff(50) /-0.2810, -0.3095/
	data xoff(51), yoff(51) /-0.2975, -0.3020/
	data xoff(52), yoff(52) /-0.2915, -0.3020/
	data xoff(53), yoff(53) /-0.2975, -0.2945/
	data xoff(54), yoff(54) /-0.3230, -0.3020/
	data xoff(55), yoff(55) /-0.2915, -0.3020/
	data xoff(56), yoff(56) /-0.3000, -0.3020/
	data xoff(57), yoff(57) /-0.3230, -0.3020/
	data xoff(58), yoff(58) /-0.3000, -0.2010/
	data xoff(59), yoff(59) /-0.2445, -0.1380/
	data xoff(60), yoff(60) /-0.3000, -0.2810/
	data xoff(61), yoff(61) /-0.3000, -0.2810/
	data xoff(62), yoff(62) /-0.3000, -0.2810/
	data xoff(63), yoff(63) /-0.3105, -0.2965/
	data xoff(64), yoff(64) /-0.2915, -0.2810/
	data xoff(65), yoff(65) /-0.3000, -0.2815/
	data xoff(66), yoff(66) /-0.2920, -0.2815/
	data xoff(67), yoff(67) /-0.2985, -0.2815/
	data xoff(68), yoff(68) /-0.2815, -0.2815/
	data xoff(69), yoff(69) /-0.2815, -0.2815/
	data xoff(70), yoff(70) /-0.2815, -0.2815/
	data xoff(71), yoff(71) /-0.3125, -0.2815/
	data xoff(72), yoff(72) /-0.3020, -0.2815/
	data xoff(73), yoff(73) /-0.3000, -0.2815/
	data xoff(74), yoff(74) /-0.3335, -0.2740/
	data xoff(75), yoff(75) /-0.3075, -0.2815/
	data xoff(76), yoff(76) /-0.3020, -0.2815/
	data xoff(77), yoff(77) /-0.3020, -0.2815/
	data xoff(78), yoff(78) /-0.2920, -0.2815/
	data xoff(79), yoff(79) /-0.3000, -0.2815/
	data xoff(80), yoff(80) /-0.2710, -0.2815/
	data xoff(81), yoff(81) /-0.3000, -0.2310/
	data xoff(82), yoff(82) /-0.3160, -0.2815/
	data xoff(83), yoff(83) /-0.3000, -0.2815/
	data xoff(84), yoff(84) /-0.3000, -0.2815/
	data xoff(85), yoff(85) /-0.3000, -0.2740/
	data xoff(86), yoff(86) /-0.3000, -0.2815/
	data xoff(87), yoff(87) /-0.3000, -0.2815/
	data xoff(88), yoff(88) /-0.3000, -0.2815/
	data xoff(89), yoff(89) /-0.3000, -0.2815/
	data xoff(90), yoff(90) /-0.3000, -0.2815/
	data xoff(91), yoff(91) /-0.3625, -0.2400/
	data xoff(92), yoff(92) /-0.3000, -0.2915/
	data xoff(93), yoff(93) /-0.2375, -0.2400/
	data xoff(94), yoff(94) /-0.3000, -0.4795/
	data xoff(95), yoff(95) /-0.3000, +0.2500/
	data xoff(96), yoff(96) /-0.3625, -0.4585/
	data xoff(97), yoff(97) /-0.3065, -0.2085/
	data xoff(98), yoff(98) /-0.2815, -0.2945/
	data xoff(99), yoff(99) /-0.3095, -0.2085/
	data xoff(100), yoff(100) /-0.3230, -0.2945/
	data xoff(101), yoff(101) /-0.2915, -0.2085/
	data xoff(102), yoff(102) /-0.3230, -0.3020/
	data xoff(103), yoff(103) /-0.3125, -0.1225/
	data xoff(104), yoff(104) /-0.2970, -0.3020/
	data xoff(105), yoff(105) /-0.3000, -0.3225/
	data xoff(106), yoff(106) /-0.3025, -0.2290/
	data xoff(107), yoff(107) /-0.3020, -0.3020/
	data xoff(108), yoff(108) /-0.3000, -0.3020/
	data xoff(109), yoff(109) /-0.3020, -0.2160/
	data xoff(110), yoff(110) /-0.2970, -0.2160/
	data xoff(111), yoff(111) /-0.3000, -0.2085/
	data xoff(112), yoff(112) /-0.2815, -0.1225/
	data xoff(113), yoff(113) /-0.3230, -0.1225/
	data xoff(114), yoff(114) /-0.3125, -0.2140/
	data xoff(115), yoff(115) /-0.3000, -0.2085/
	data xoff(116), yoff(116) /-0.2710, -0.2735/
	data xoff(117), yoff(117) /-0.2920, -0.2010/
	data xoff(118), yoff(118) /-0.3000, -0.2085/
	data xoff(119), yoff(119) /-0.3000, -0.2085/
	data xoff(120), yoff(120) /-0.3000, -0.2085/
	data xoff(121), yoff(121) /-0.3000, -0.1150/
	data xoff(122), yoff(122) /-0.3020, -0.2085/
	data xoff(123), yoff(123) /-0.3000, -0.2400/
	data xoff(124), yoff(124) /-0.3000, -0.2400/
	data xoff(125), yoff(125) /-0.3000, -0.2400/
	data xoff(126), yoff(126) /-0.3000, -0.2810/
C
C   Character translation table for centered characters
C
	data (ctable(i), i =   0,  3) / 35,111, 73, 43/
	data (ctable(i), i =   4,  7) / 88, 72, 94,126/
	data (ctable(i), i =   8, 11) / 90, 89, 36, 42/
	data (ctable(i), i =  12, 15) / 56,124, 37, 43/
	data (ctable(i), i =  16, 19) / 43, 43, 43, 43/
	data (ctable(i), i =  20, 23) / 43, 43, 43, 43/
	data (ctable(i), i =  24, 27) / 43, 43, 43, 43/
	data (ctable(i), i =  28, 31) / 43, 43, 43, 43/
	data (ctable(i), i =  32, 35) / 32, 33, 34, 35/
	data (ctable(i), i =  36, 39) / 36, 37, 38, 39/
	data (ctable(i), i =  40, 43) / 40, 41, 42, 43/
	data (ctable(i), i =  44, 47) / 44, 45, 46, 47/
	data (ctable(i), i =  48, 51) / 48, 49, 50, 51/
	data (ctable(i), i =  52, 55) / 52, 53, 54, 55/
	data (ctable(i), i =  56, 59) / 56, 57, 58, 59/
	data (ctable(i), i =  60, 63) / 60, 61, 62, 63/
	data (ctable(i), i =  64, 67) / 64, 65, 66, 67/
	data (ctable(i), i =  68, 71) / 68, 69, 70, 71/
	data (ctable(i), i =  72, 75) / 72, 73, 74, 75/
	data (ctable(i), i =  76, 79) / 76, 77, 78, 79/
	data (ctable(i), i =  80, 83) / 80, 81, 82, 83/
	data (ctable(i), i =  84, 87) / 84, 85, 86, 87/
	data (ctable(i), i =  88, 91) / 88, 89, 90, 91/
	data (ctable(i), i =  92, 95) / 92, 93, 94, 95/
	data (ctable(i), i =  96, 99) / 96, 97, 98, 99/
	data (ctable(i), i = 100,103) /100,101,102,103/
	data (ctable(i), i = 104,107) /104,105,106,107/
	data (ctable(i), i = 108,111) /108,109,110,111/
	data (ctable(i), i = 112,115) /112,113,114,115/
	data (ctable(i), i = 116,119) /116,117,118,119/
	data (ctable(i), i = 120,123) /120,121,122,123/
	data (ctable(i), i = 124,127) /124,125,126, 43/
C
C   Bad input check
C
	if (nchin .lt. -2 .or. ht .le. 0.0) return

C
C   Initialise lots of stuff
C
	x = xin
	y = yin
	nch = nchin
	if (x .eq. 999.) call where(x, dum1, dum2)
	if (y .eq. 999.) call where(dum1, y, dum2)

	if (nchin .ne. -2) then
	    call plot (x, y, 3)
	else
	    call plot (x, y, 2)
	endif

C
C   Round angle to integer - good to 1 degree
C
	intang = nint(ang)
	cosang = cos(float(intang) * 0.017453292519)
	sinang = sin(float(intang) * 0.017453292519)

C
C   Set char height
C
	if (ht .ne. htold) then
	    call pliout (nint (ht * cfudge * fac * ires))
	    call plsout (" H ")
	    htold = ht
	endif


C
C   Plot a string of characters
C
	if (nch .gt. 0) then
C
C	Set char angle
C
	    if (intang .ne. 0) then
		call pliout (intang)
		call plsout (" RS ")
	    end if

C
C	Transfer chars into holding area
C
	    nfwd = nch/4
	    if (mod (nch, 4) .ne. 0) nfwd = nfwd + 1

	    do 10 i = 1, nfwd
		istr(i) = strin(i)
10	    continue

C
C	Output "(string) S ", escape ( ) \
C
	    call plcout(40)

	    do 20 i = 1, nch
		ic = mod(ichar(cstr(i:i)), 127)
		if	(ic .eq. 40) then
		    call plsout ("\\050")
		else if	(ic .eq. 41) then
		    call plsout ("\\051")
		else if	(ic .eq. 92) then
		    call plsout ("\\134")
		else
		    call plcout(ic)
		end if
20	    continue

	    call plsout(") S ")

C
C       Update our idea of where the pen is.
C
	    xold = x + (nch * ht * fac * cosang)
	    yold = y + (nch * ht * fac * sinang)
C
C	Undo character angle
C
	    if (intang .ne. 0) then
		call plsout ("RE\n")
	    else
		call plcout (10)
	    endif

C
C   Plot one char in strin
C
	else if (nch .eq. 0) then
C
C	Set char angle
C
	    if (intang .ne. 0) then
		call pliout (intang)
		call plsout (" RS ")
	    end if

C
C	Output "(c) S ", escape "(" and ")" and "\"
C
	    call plcout (40)
	    ic = mod(ichar(char(strin(1))), 127)
	    if      (ic .eq. 40) then
		call plsout ("\\050")
	    else if (ic .eq. 41) then
		call plsout ("\\051")
	    else if (ic .eq. 92) then
		call plsout ("\\134")
	    else
		call plcout(ic)
	    end if
	    call plsout (") S ")

C
C   Update our idea of where the pen is.
C
	    xold = x + (ht * fac * cosang)
	    yold = y + (ht * fac * sinang)
C
C	Undo character angle
C
	    if (intang .ne. 0) then
		call plsout ("RE\n")
	    else
		call plcout (10)
	    endif

C
C   Plot special centered symbols
C
	else if (nch .eq. -1 .or. nch .eq. -2) then
C
C	Set char angle
C
	    call pliout (intang)
	    call plsout (" RS ")

C
C	Look up character
C
	    ic = ctable(mod(ichar(char(strin(1))), 127))

C
C	Plot centered character -
C	  output "xoff yoff RM (c) S ", escape ( ) \
C
	    call pliout (nint (xoff(ic) * ht * cfudge * fac * ires))
	    call plcout (32)
	    call pliout (nint (yoff(ic) * ht * cfudge * fac * ires))
	    call plsout (" RM (")
	    if      (ic .eq. 40) then
		call plsout ("\\050")
	    else if (ic .eq. 41) then
		call plsout ("\\051")
	    else if (ic .eq. 92) then
		call plsout ("\\134")
	    else
		call plcout(ic)
	    end if
	    call plsout (") S ")
C
C	Update our idea of where the pen is
C
	    xold = x
	    yold = y
C
C	 Undo character angle
C
	    call plsout ("RE\n")

	end if

	return
	end
