projects / pdp8.git / blame
| 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 |