File: NUMBER.FT of Disk: V50/Source/Source-Listing-RALF-1
(Source file text)
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. 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