home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / libs / matlab.lzh / MATLAB / MATLAB.LZH / Source / MatLab / BASE.FOR next >
Encoding:
Text File  |  1991-04-13  |  1.2 KB  |  52 lines
  1.       SUBROUTINE BASE (X, B, EPS, S, N)
  2.       IMPLICIT NONE
  3. C
  4. C STORE BASE B REPRESENTATION OF X IN S(1:N)
  5. C
  6.       DOUBLE PRECISION X, B, EPS, S(*), T
  7. C
  8.       INTEGER PLUS, MINUS, DOT, ZERO, COMMA, J, K, L, M
  9. C
  10.       DOUBLE PRECISION DFLOAT
  11. C
  12.       DATA PLUS / 41 /, MINUS / 42 /, DOT / 47 /
  13.       DATA ZERO / 0 /, COMMA / 48 /
  14. C
  15. C
  16.       L = 1
  17.       IF (X.GE.0.0D0) S(L) = PLUS
  18.       IF (X.LT.0.0D0) S(L) = MINUS
  19.       S(L+1) = ZERO
  20.       S(L+2) = DOT
  21.       X = DABS (X)
  22.       IF (X.NE.0.0D0) K = DLOG (X)/DLOG (B)
  23.       IF (X.EQ.0.0D0) K = 0
  24.       IF (X.GT.1.0D0) K = K+1
  25.       X = X/B**K
  26.       IF (B*X.GE.B) K = K+1
  27.       IF (B*X.GE.B) X = X/B
  28.       IF (EPS.NE.0.0D0) M = -DLOG (EPS)/DLOG (B)+4
  29.       IF (EPS.EQ.0.0D0) M = 54
  30.       DO 10 L = 4, M
  31.         X = B*X
  32.         J = IDINT (X)
  33.         S(L) = DFLOAT (J)
  34.         X = X-S(L)
  35. 10    CONTINUE
  36.       S(M+1) = COMMA
  37.       IF (K.GE.0) S(M+2) = PLUS
  38.       IF (K.LT.0) S(M+2) = MINUS
  39.       T = DABS (DFLOAT (K))
  40.       N = M+3
  41.       IF (T.GE.B) N = N+IDINT (DLOG (T)/DLOG (B))
  42.       L = N
  43. 20    CONTINUE
  44.       J = IDINT (DMOD (T, B))
  45.       S(L) = DFLOAT (J)
  46.       L = L-1
  47.       T = T/B
  48.       IF (L.GE.M+3) GO TO 20
  49. C
  50.       RETURN
  51.       END
  52.