C  NUMBER SUBROUTINE FOR OS8 FORTRAN IV
C  CURES MALFUNCTIONS OF DEC'S ROUTINE,
C  AND IS CONSIDERABLY SMALLER.
C  EUGENE J. M. LYNCH
C  XEROX CORPORATION
C  XEROX SQUARE W129
C  ROCHESTER, NY 14644
C  MAY 4, 1978
	SUBROUTINE NUMBER(XS,YS,HGT,ANUM,ANG,IDIG)
C  SEE HANDBOOK FOR ARGUMENTS
	DIMENSION ANMPAS(21)
C  -3 FOR MINUS SIGN;  NEVER OVERWRITTEN
	DATA ANMPAS /-3.,20*0/
	IDGCNT=1
10	PABS=ABS(ANUM)
C  ROUND MAGNITUDE IF REQUIRED
	IF(IDIG.GT.0)PABS=(PABS*(10.**IDIG)+.5)/(10.**IDIG)
C  GET INTEGER & FRACTIONAL PARTS
	IPART=PABS
	FPART=PABS-IPART
C  COUNT INTEGER DIGITS
20	IF(IPART/(10.**IDGCNT).LT.1) GO TO 30
	IDGCNT=IDGCNT+1
	GO TO 20

C  GET TOTAL DIGITS

30	LDIG=IDGCNT+IDIG+1

C  ERROR IF UNDER/OVERFLOW

	IF((IDGCNT.LT.20).AND.(LDIG.LE.20).AND.(LDIG.GT.0))GO TO 35
	WRITE(0,200)
	RETURN
200	FORMAT(' NUMBER OF DIGITS NOT 1-19'/)

C  ENCODE INTEGER PART

35	PABS=(FLOAT(IPART)+.5)/(10.**(IDGCNT-1))
	DO 40 J=1,IDGCNT
	ANMPAS(J+1)=AINT(PABS)
	PABS=(PABS-ANMPAS(J+1))*10.
40	CONTINUE

C  BRANCH IF NO DECIMAL POINT

	IF(IDIG.LT.0) GO TO 51

C  INSERT DECIMAL POINT (-2)

	J=J+1
	ANMPAS(J)=-2.

C  BRANCH IF NO FRACTIONAL PART

	IF(IDIG.LT.1)GO TO 51

C  ENCODE FRACTIONAL PART

	DO 50 IPART=1,IDIG
	PABS=FPART*10.
	J=J+1
	ANMPAS(J)=AINT(PABS)
	FPART=PABS-ANMPAS(J)
50	CONTINUE
C  SET FOR POSITIVE VALUE
51	IPART=2
C  CHECK FOR NEGATIVE UNLESS ALL ZERO
	DO 52 J=1,LDIG
	IF(ANMPAS(J+1).GT..5) GO TO 54
52	CONTINUE
	GO TO 55
54	IF (ANUM.GE.0) GO TO 55
C  INCLUDE MINUS SIGN
	IPART=1
	LDIG=LDIG+1
C  GO TO SPECIAL SYMBOL ENTRY
55	CALL SYMB(XS,YS,HGT,ANMPAS(IPART),ANG,LDIG)
	END