home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d2xx / d267 / diglib.lha / Diglib / diglib.zoo / diglib / LINLAB.FOR < prev    next >
Encoding:
Text File  |  1989-06-20  |  1.6 KB  |  64 lines
  1.         SUBROUTINE LINLAB(NUM,IEXP,STRNG,LRMTEX)
  2.         LOGICAL*1 LRMTEX
  3.     CHARACTER*1 STRNG(8)
  4. C
  5.         CHARACTER*1 BMINUS, BZERO(4)
  6.         EXTERNAL LEN
  7.         DATA BMINUS /'-'/
  8.         DATA BZERO /'0', '.', '0',0/
  9. C
  10. C
  11.         LRMTEX = .TRUE.
  12. C
  13. C       WORK WITH ABSOLUTE VALUE AS IT IS EASIER TO PUT SIGN IN NOW
  14. C
  15.         IF (NUM .LT. 0) GO TO 10
  16.                 NVAL = NUM
  17.                 ISTART = 1
  18.                 GO TO 20
  19. 10          CONTINUE
  20.                 NVAL = -NUM
  21.                 ISTART = 2
  22.                 STRNG(1) = BMINUS
  23. 20      CONTINUE
  24.         IF (IEXP .GE. -2 .AND. IEXP .LE. 2) LRMTEX = .FALSE.
  25.         IF (IEXP .GT. 0 .AND. (.NOT. LRMTEX)) NVAL = NVAL*10**IEXP
  26. C
  27.     CALL NUMSTR(NVAL,STRNG(ISTART))
  28. C
  29.         IF ((NVAL .EQ. 0) .OR. LRMTEX .OR. (IEXP .GE. 0)) GOTO 800
  30. C
  31. C       NUMBER IS IN RANGE 10**-1 OR 10**-2, SO FORMAT PRETTY
  32. C
  33.         N = -IEXP
  34.         L = LEN(STRNG(ISTART))
  35.         IZBGN = 1
  36.         NIN = 3
  37.         IF (N .EQ. L) NIN = 2
  38. C
  39. C       IF N<L THEN WE NEED ONLY INSERT A DECIMAL POINT
  40. C
  41.         IF (N .GE. L) GO TO 40
  42.                 IZBGN = 2
  43.                 NIN = 1
  44. 40      CONTINUE
  45. C
  46. C       ALLOW ROOM FOR DECIMAL POINT AND ZERO(S) IF NECESSARY
  47. C
  48.         IBEGIN = ISTART + MAX0(0,L-N)
  49.                 DO 50 I = 0, MIN0(N,L)
  50.                 STRNG(ISTART+L+NIN-I) = STRNG(ISTART+L-I)
  51. 50              CONTINUE
  52. C
  53. C       INSERT LEADING ZEROS IF NECESSARY, OR JUST DECIMAL POINT
  54. C
  55.                 DO 60 I=0,NIN-1
  56.                 STRNG(IBEGIN+I) = BZERO(IZBGN+I)
  57. 60              CONTINUE
  58. C
  59. C       ALL DONE
  60. C
  61. 800    CONTINUE
  62.         RETURN
  63.         END
  64.