home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d2xx / d267 / diglib.lha / Diglib / diglib.zoo / diglib / AXIS.FOR < prev    next >
Encoding:
Text File  |  1989-06-20  |  3.7 KB  |  130 lines
  1.         SUBROUTINE AXIS(BLOW,BHIGH,MAXTKS,LSHORT,LRAGGD,BMIN,BMAX,
  2.      1   BTMIN,BTMAX,BTICK,IPWR)
  3.         LOGICAL*1 LSHORT, LRAGGD
  4. C
  5. C       THIS SUBROUTINE IS MAINLY FOR INTERNAL USE,
  6. C       ITS FUNCTION IS TO DETERMINE A SUITABLE
  7. C       "TICK" DISTANCE OVER THE RANGE SPECIFIED BETWEEN
  8. C       ALOW AND AHIGH.   IT OUTPUTS THE AXIS RANGE BMIN,BMAX
  9. C       AND THE TICK DISTANCE BTICK STRIPPED OF THEIR POWER OF
  10. C       TEN.   THE POWER OF TEN IS RETURNED IN THE VAR. IPWR.
  11. C
  12.         DIMENSION JTICKS(6)
  13.         LOGICAL*2 LDIVDS
  14.         LOGICAL*1 LISNEG
  15. C
  16. C       IF A RAGGED AXIS IS "TOO CLOSE" TO THE NEXT TICK, THEN EXTEND IT.
  17. C        THE "TOO CLOSE" PARAMETER IS THE VARIABLE TOOCLS
  18. C
  19.         DATA TOOCLS /0.8/
  20. C
  21.         DATA FUZZ /0.001/
  22.         DATA JTICKS /1,2,5,4,3,10/
  23. C
  24. C
  25.         MAXTKS = MAX0(1,MAXTKS)
  26.         MINTKS = MAX0(1,MAXTKS/2)
  27.         BMAX = BHIGH
  28.         BMIN = BLOW
  29.         LISNEG = .FALSE.
  30.         IF (BMAX .GE. BMIN) GO TO 30
  31.         BMAX = BLOW
  32.         BMIN = BHIGH
  33.         LISNEG = .TRUE.
  34. C
  35. C       MAKE SURE WE HAVE ENOUGH RANGE, IF NOT, INCREASE AHIGH
  36. C
  37. 30      RANGE = BMAX - BMIN
  38.         TEMP = AMAX1(ABS(BMIN),ABS(BMAX))
  39.         IF (TEMP .EQ. 0.0) TEMP = 10.0
  40.         IF (RANGE/TEMP .GE. 5.0E-3) GO TO 40
  41.                 BMIN = BMIN - 5.0E-3*TEMP
  42.                 BMAX = BMAX + 5.0E-3*TEMP
  43. 40      CONTINUE
  44. C
  45. C       STRIP THE RANGE OF ITS POWER OF TEN
  46. C
  47.         IPWR=ALOG10(BMAX-BMIN)-2
  48. 50      TENX = 10.0**IPWR
  49.         ASTRT = AINT(BMIN/TENX)
  50.         AFIN = AINT(BMAX/TENX+0.999)
  51.         IF (AFIN*TENX .LT. BMAX) AFIN = AFIN + 1
  52.         RANGE = AFIN - ASTRT
  53.         IF (RANGE .LE. 10*MAXTKS) GO TO 75
  54.         IPWR = IPWR + 1
  55.         GO TO 50
  56. 75      CONTINUE
  57. C
  58. C       SEARCH FOR A SUITABLE TICK
  59. C
  60. D       TYPE 9999, BMIN, ASTRT, BMAX, AFIN, TENX
  61. D9999   FORMAT(/' AXIS DEBUG'/'      DATA          STRIPPED'/
  62. D       1   2(1X,G14.7,2X,G14.7/)/' POWER = ',G14.7)
  63.         BTICK = 0
  64.         DO 100 I=1,6
  65.         TICK = JTICKS(I)
  66.         NTICK = RANGE/TICK+0.999
  67.         IF (NTICK .LT. MINTKS .OR. NTICK .GT. MAXTKS) GO TO 100
  68.         IF (LDIVDS(ASTRT,TICK) .AND. LDIVDS(AFIN,TICK)) GO TO 150
  69.         IF (BTICK .EQ. 0) BTICK = TICK
  70. 100     CONTINUE
  71. C
  72. C       USE BEST NON-PERFECT TICK
  73. C
  74.         GO TO 160
  75. C
  76. C       FOUND A GOOD TICK
  77. C
  78. 150     BTICK=JTICKS(I)
  79. 160     CONTINUE
  80.         IF (BTICK .NE. 10.0) GO TO 165
  81.           BTICK = 1.0
  82.           IPWR = IPWR + 1
  83.           TENX = 10.0*TENX
  84. 165     TICK = BTICK*TENX
  85. C
  86. C       FIGURE OUT TICK LIMITS
  87. C
  88.         BTMIN = BTICK*AINT(BMIN/TICK)
  89.         IF (BTMIN*TENX .LT. BMIN) BTMIN = BTMIN + BTICK
  90.         BTMAX = BTICK*AINT(BMAX/TICK)
  91.         IF (BTMAX*TENX .GT. BMAX) BTMAX = BTMAX - BTICK
  92.         NINTVL = (BTMAX-BTMIN)/BTICK
  93. C
  94. C       IF USER ABSOLUTELY MUST HAVE RAGGED AXIS, THEN FORCE IT.
  95. C
  96.         IF (LSHORT .AND. LRAGGD) GO TO 180
  97. C
  98. C       CHECK INDIVIDUALLY
  99. C
  100.         IF (LSHORT .AND. (NINTVL .GT. 0) .AND.
  101.      1   ((BTMIN-BMIN/TENX)/BTICK .LE. TOOCLS) ) GO TO 170
  102.           IF ((BTMIN-BMIN/TENX) .GT. FUZZ) BTMIN = BTMIN - BTICK
  103.           BMIN = BTMIN*TENX
  104. 170     CONTINUE
  105.         IF (LSHORT .AND. (NINTVL .GT. 0) .AND.
  106.      1   ((BMAX/TENX-BTMAX)/BTICK .LE. TOOCLS) ) GO TO 180
  107.           IF ((BMAX/TENX-BTMAX) .GT. FUZZ) BTMAX = BTMAX + BTICK
  108.           BMAX = BTMAX*TENX
  109. 180     CONTINUE
  110.         IF (.NOT. LISNEG) GO TO 200
  111. C       SWITCH BACK TO BACKWARDS
  112.         BTICK = -BTICK
  113.         TEMP = BMIN
  114.         BMIN = BMAX
  115.         BMAX = TEMP
  116.         TEMP = BTMIN
  117.         BTMIN = BTMAX
  118.         BTMAX = TEMP
  119. 200     RETURN
  120.         END
  121.  
  122.         FUNCTION LDIVDS(ANUMER,ADENOM)
  123.         LOGICAL*2 LDIVDS
  124.         IF (ANUMER/ADENOM .EQ. AINT(ANUMER/ADENOM)) GO TO 10
  125.         LDIVDS = .FALSE.
  126.         RETURN
  127. 10      LDIVDS = .TRUE.
  128.         RETURN
  129.         END
  130.