sw/rescue/lab8e_goettingen/disk2_11/rkb/paroff/number.ft

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