File: NUMBER.LS of Disk: V50/Source/Source-Listing-RALF-1

(Source file text) 

---

        FORTRAN IV  5AAAA (A6)   8-APR-92             PAGE  ONE 

0002	        SUBROUTINE NUMBER(XS,YS,HGT,ANUM,ANG,IDIG)
	C       VERSION 50A 30-MAY-80 WVDM
	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.
0003	        DIMENSION ANMPAS(21)
	C       ENOUGH FOR 19 DIGITS.
0004	        DO 5 J=1,21
0005	        ANMPAS(J)=0.
0006	5       CONTINUE
0007	        IDGCNT=1
0010	        J=1
0011	10      PABS=ABS(ANUM)
0012	        IPART=PABS
0013	        FPART=PABS-IPART
	C       COUNT NUMBER OF DIGITS TO PRINT
0014	20      IF(IPART/(10.**IDGCNT).LT.1) GO TO 30
	C       DONE WITH WHOLE PART OF NUMBER WHEN JUMP
0015	        IDGCNT=IDGCNT+1
0016	        GO TO 20
0017	30      IF(IDGCNT.GT.21) GO TO 100
0020	        PABS=(FLOAT(IPART)+.5)/(10.**(IDGCNT-1))
0021	        DO 40 J=1,IDGCNT
0022	        ANMPAS(J)=AINT(PABS)
0023	        PABS=(PABS-ANMPAS(J))*10.
0024	40      CONTINUE
	C       FILL UP ARRAY WITH WHOLE ELEMENTS
0025	        J=IDGCNT
0026	        LDIG=IDGCNT+IDIG+1
0027	        IF(LDIG.GT.20)GO TO 100
0030	        IF(IDIG.LT.0)GO TO 51
0031	        J=J+1
0032	        ANMPAS(J)=-2.
	C       FOR DECIMAL POINT
0033	        IF(IDIG.LT.1)GO TO 51
	C       FOR THE IDIG=0 CASE
0034	        DO 50 IPART=1,IDIG+1
	C       EXTRA PLACE TO CHECK FOR ROUNDING
0035	        PABS=FPART*10.
0036	        J=J+1
0037	        ANMPAS(J)=AINT(PABS)
0040	        FPART=PABS-ANMPAS(J)
0041	50      CONTINUE
0042	        FPART=-3.
0043	        IF(ANUM.LT.0)GO TO 52
	C       PREPARE FOR POSITIVE NUMBER ROUNDING
0044	        IF(ANMPAS(J).LT.5)GO TO 55
0045	        ANMPAS(J-1)=ANMPAS(J-1)+1.
0046	59      IF(ANMPAS(J-1).NE.10)GO TO 55
0047	        IF(ANMPAS(J-2).NE.-2.)GO TO 53
0050	        J=J-1
0051	        IF(ANUM.GE.1)GO TO 53
0052	        ANMPAS(J-2)=1.
0053	        GO TO 55
        FORTRAN IV  5AAAA (A6)   8-APR-92             PAGE  TWO 

0054	53      ANMPAS(J-2)=ANMPAS(J-2)+1.
0055	        J=J-1
	C       CHECK NOT TO OVERFLOW ANMPAS
0056	        IF(J.NE.2)GO TO 59
0057	        FPART=1.
	C       MOVE ARRAY DOWN BY 1 TO ADD- OR 1 FOR 9.99+
0060	52      LDIG=LDIG+1
0061	        J=1
0062	        DO 60 J=1,LDIG-1
0063	        ANMPAS(LDIG-J+1)=ANMPAS(LDIG-J)
0064	60      CONTINUE
0065	        ANMPAS(1)=FPART
0066	        GO TO 55
0067	51      FPART=-3.
0070	        IF(LDIG.LE.0)GO TO 100
	C       FOR NEGATIVE NUMBERS WITH TOO FEW PLACES
0071	        IF(ANUM.LT.0)GO TO 52
0072	55      IF(LDIG.GT.21).OR.(LDIG.LE.0)GO TO 100
0073	        CALL SYMB(XS,YS,HGT,ANMPAS,ANG,LDIG)
0074	120     RETURN
0075	100     WRITE(0,200)
0076	200     FORMAT(' NUMBER OF DIGITS NOT 1-19'/)
0077	        END
	

---