Commit | Line | Data |
---|---|---|
81e70d48 PH |
1 | C \ eNUMBER.FT\r |
2 | C\r | |
3 | C NUMBER SUBROUTINE FOR OS/8 FORTRAN 4\r | |
4 | C\r | |
5 | SUBROUTINE NUMBER (XS,YS,HGT,ANUM,ANG,IDIG)\r | |
6 | DIMENSION ANMPAS(21)\r | |
7 | DO 5 J=1,21\r | |
8 | ANMPAS(J)=0.\r | |
9 | 5 CONTINUE\r | |
10 | IDGCNT=1\r | |
11 | J=1\r | |
12 | 10 PABS=ABS(ANUM)\r | |
13 | IPART=PABS\r | |
14 | FPART=PABS-IPART\r | |
15 | C COUNT NUMBER OF DIGITS TO PRINT\r | |
16 | 20 IF (IPART/(10.**IDGCNT).LT.1) GOTO 30\r | |
17 | C DONE WITH WHOLE PART OF NUMBER WHEN JUMP\r | |
18 | IDGCNT=IDGCNT+1\r | |
19 | GOTO 20\r | |
20 | 30 IF (IDGCNT.GT.21) GOTO 100\r | |
21 | PABS=(FLOAT(IPART)+.5)/10**(IDGCNT-1)\r | |
22 | DO 40 J=1,IDGCNT\r | |
23 | ANMPAS(J)=AINT(PABS)\r | |
24 | PABS=(PABS-ANMPAS(J))*10.\r | |
25 | 40 CONTINUE\r | |
26 | C FILL UP ARRAY WITH WHOLE ELEMENTS\r | |
27 | J=IDGCNT\r | |
28 | LDIG=IDGCNT+IDIG+1\r | |
29 | IF (LDIG.GT.20) GOTO 100\r | |
30 | IF (IDIG.LT.0) GOTO 51\r | |
31 | J=J+1\r | |
32 | ANMPAS(J)=-2.\r | |
33 | C FOR DECIMAL POINT\r | |
34 | IF (IDIG.LT.1) GOTO 51\r | |
35 | C FOR IDIG=0 CASE\r | |
36 | DO 50 IPART=1,IDIG+1\r | |
37 | C EXTRA PLACE TO CHECK FOR ROUNDING\r | |
38 | PABS=FPART*10.\r | |
39 | J=J+1\r | |
40 | ANMPAS(J)=AINT(PABS)\r | |
41 | FPART=PABS-ANMPAS(J)\r | |
42 | 50 CONTINUE\r | |
43 | FPART=-3.\r | |
44 | IF (ANUM.LT.0) GOTO 52\r | |
45 | C PREPARE FOR POSITIVE NUMBER ROUNDING\r | |
46 | IF (ANMPAS(J).LT.5) GOTO 55\r | |
47 | ANMPAS(J-1)=ANMPAS(J-1)+1\r | |
48 | 59 IF (ANMPAS(J-1).NE.10) GOTO 55\r | |
49 | C BE SHURE NOT TO INDEX THE DECIMAL POINT\r | |
50 | IF (ANMPAS(J-2).NE.-2.) GOTO 53\r | |
51 | J=J-1\r | |
52 | IF (ANUM.GE.1) GOTO 53\r | |
53 | ANMPAS(J-2)=1.\r | |
54 | GOTO 55\r | |
55 | 53 ANMPAS(J-2)=ANMPAS(J-2)+1\r | |
56 | J=J-1\r | |
57 | C CHECK TO OVERFLOW ANMPAS\r | |
58 | IF (J.NE.2) GOTO 59\r | |
59 | FPART=1.\r | |
60 | C MOVE ARRAY DOWN BY ONE TO ADD - OR 1 FOR .99+\r | |
61 | 52 LDIG=LDIG+1\r | |
62 | J=1\r | |
63 | DO 60 J=1,LDIG-1\r | |
64 | ANMPAS(LDIG-J+1)=ANMPAS(LDIG-J)\r | |
65 | 60 CONTINUE\r | |
66 | ANMPAS(1)=FPART\r | |
67 | GOTO 55\r | |
68 | 51 FPART=-3.\r | |
69 | IF (LDIG.LE.0) GOTO 100\r | |
70 | C FOR NEG. NUMBERS WITH TOO FEW PLACES\r | |
71 | IF (ANUM.LT.0) GOTO 52\r | |
72 | 55 IF (LDIG.GT.21 .OR.LDIG.LE.0) GOTO 100\r | |
73 | CALL SYMB (XS,YS,HGT,ANMPAS,ANG,LDIG)\r | |
74 | 120 RETURN\r | |
75 | 100 WRITE (0,200)\r | |
76 | 200 FORMAT (' NUMBER OF DIGITS NOT 1-19')\r | |
77 | END\r | |
78 | \1a\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0 |