File: NUMBER.FT of Tape: Various/ETH/f2

(Source file text) 

---

	SUBROUTINE NUMBER(XS,YS,HGT,ANUM,ANG,IDIG)
C	XS,YS=ORIGIN, HGT=HEIGHT, ANUM=NUMBER AS A VARIABLE, ANG=ANGLE
C	IDIG: GT 0 = NUM SIGNIFICANT PLACES+ROUND+DEC.PT;
C	0 = NO ROUND,DEC PT,NO FRACT;-1 = NO ROUND, NO DEC.PT;
C	LT -1 = TRUNCATE IDIG-1 PLACES.
	DIMENSION ANMPAS(21)
C	ENOUGH FOR 19 DIGITS.
	DO 5 J=1,21
	ANMPAS(J)=0.
5	CONTINUE
	IDGCNT=1
	J=1
10	PABS=ABS(ANUM)
	IPART=PABS
	FPART=PABS-IPART
C	COUNT NUMBER OF DIGITS TO PRINT
20	IF(IPART/(10.**IDGCNT).LT.1) GO TO 30
C	DONE WITH WHOLE PART OF NUMBER WHEN JUMP
	IDGCNT=IDGCNT+1
	GO TO 20
30	IF(IDGCNT.GT.21) GO TO 100
	PABS=(FLOAT(IPART)+.5)/(10.**(IDGCNT-1))
	DO 40 J=1,IDGCNT
	ANMPAS(J)=AINT(PABS)
	PABS=(PABS-ANMPAS(J))*10.
40	CONTINUE
C	FILL UP ARRAY WITH WHOLE ELEMENTS
	J=IDGCNT
	LDIG=IDGCNT+IDIG+1
	IF(LDIG.GT.20)GO TO 100
	IF(IDIG.LT.0)GO TO 51
	J=J+1
	ANMPAS(J)=-2.
C	FOR DECIMAL POINT
	IF(IDIG.LT.1)GO TO 51
C	FOR THE IDIG=0 CASE
	DO 50 IPART=1,IDIG+1
C	EXTRA PLACE TO CHECK FOR ROUNDING
	PABS=FPART*10.
	J=J+1
	ANMPAS(J)=AINT(PABS)
	FPART=PABS-ANMPAS(J)
50	CONTINUE
	FPART=-3.
	IF(ANUM.LT.0)GO TO 52
C	PREPARE FOR POSITIVE NUMBER ROUNDING
	IF(ANMPAS(J).LT.5)GO TO 55
	ANMPAS(J-1)=ANMPAS(J-1)+1.
59	IF(ANMPAS(J-1).NE.10)GO TO 55
	IF(ANMPAS(J-2).NE.-2.)GO TO 53
	J=J-1
	IF(ANUM.GE.1)GO TO 53
	ANMPAS(J-2)=1.
	GO TO 55
53	ANMPAS(J-2)=ANMPAS(J-2)+1.
	J=J-1
C	CHECK NOT TO OVERFLOW ANMPAS
	IF(J.NE.2)GO TO 59
	FPART=1.
C	MOVE ARRAY DOWN BY 1 TO ADD- OR 1 FOR 9.99+
52	LDIG=LDIG+1
	J=1
	DO 60 J=1,LDIG-1
	ANMPAS(LDIG-J+1)=ANMPAS(LDIG-J)
60	CONTINUE
	ANMPAS(1)=FPART
	GO TO 55
51	FPART=-3.
	IF(LDIG.LE.0)GO TO 100
C	FOR NEGATIVE NUMBERS WITH TOO FEW PLACES
	IF(ANUM.LT.0)GO TO 52
55	IF(LDIG.GT.21).OR.(LDIG.LE.0)GO TO 100
	CALL SYMB(XS,YS,HGT,ANMPAS,ANG,LDIG)
120	RETURN
100	WRITE(0,200)
200	FORMAT(' NUMBER OF DIGITS NOT 1-19'/)
	END

---