home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l292 / 1.ddi / SELIB.FOR < prev    next >
Encoding:
Text File  |  1990-05-02  |  20.6 KB  |  691 lines
  1.       include 'FGRAPH.FI'
  2.  
  3.  
  4.  
  5.       SUBROUTINE ConvertNum (innum, a1, a2, TicSpace, LogFlag, outstr)
  6.       INCLUDE 'GRAFTYPE.FOR'
  7.       REAL innum, a1, a2, TicSpace, tempnum
  8.       LOGICAL LogFlag
  9.       INTEGER  n1, n2, cwin, i
  10.       CHARACTER * 80 outstr
  11.       RECORD /grstype/ grstat(1:10)
  12.       COMMON /GrAttr/ grstat, cwin
  13.       DO i = 1, 80
  14.         outstr(i:i) = ' '
  15.       END DO
  16.       tempnum = innum
  17.  
  18.       IF (LogFlag) THEN
  19.         n2 = NumExp(tempnum)
  20.         n1 = NumExp(tempnum)
  21.       ELSE
  22.         IF (ABS(a2) .GE. ABS(a1)) THEN
  23.           n1 = NumExp(a2)
  24.         ELSE
  25.           n1 = NumExp(a1)
  26.         END IF
  27.         n2 = NumExp(TicSpace) - 1
  28.       END IF
  29.  
  30.       SELECT CASE (n1)
  31.          CASE (-1, -2)
  32.                   IF (n2 .LT. 0) THEN
  33.                      n2 = -n2
  34.                   ELSE
  35.                     n2 = 1
  36.                   END IF
  37.                   CALL RealToString(tempnum, n2, 1, outstr)
  38.  
  39.          CASE (0, 1, 2)
  40.                   IF (n2 .LT. 0) THEN
  41.                     n2 = -n2
  42.                   ELSE
  43.                     n2 = 1
  44.                   END IF
  45.                   CALL RealToString(tempnum, n2, 1, outstr)
  46.  
  47.         CASE (3, 4, 5)
  48.                   tempnum = tempnum / 1000.0
  49.                   n1 = n1 - 3
  50.                   n2 = n2 - 3
  51.                   IF (n2 .LT. 0) THEN
  52.                     n2 = -n2
  53.                   ELSE
  54.                     n2 = 1
  55.                   END IF
  56.                   CALL RealToString(tempnum, n2, 1, outstr)
  57.                   CALL AddChar( outstr, 'k')
  58.  
  59.          CASE (6, 7, 8)
  60.                   tempnum = tempnum / 1000000.0
  61.                   n1 = n1 - 6
  62.                   n2 = n2 - 6
  63.                   IF (n2 .LT. 0) THEN
  64.                     n2 = -n2
  65.                   ELSE
  66.                     n2 = 1
  67.                   END IF
  68.                   CALL RealToString(tempnum, n2, 1, outstr)
  69.                   CALL AddChar(outstr, 'm')
  70.          CASE (9, 10, 11)
  71.                   tempnum = tempnum / 1000000000.0
  72.                   n1 = n1 - 9
  73.                   n2 = n2 - 9
  74.                   IF (n2 .LT. 0) THEN
  75.                     n2 = -n2
  76.                   ELSE
  77.                      n2 = 1
  78.                   END IF
  79.                   CALL RealToString(tempnum, n2, 1, outstr)
  80.                   CALL AddChar(outstr, 'b')
  81.  
  82.          CASE DEFAULT
  83.            CALL RealToString(tempnum, -1, n2, outstr)
  84.       END SELECT
  85.       END !SUBROUTINE
  86.  
  87.  
  88.  
  89.  
  90.  
  91.       SUBROUTINE DrawTicX (x, y, l)
  92.       REAL x, y, l
  93.       INCLUDE 'GRAFTYPE.FOR'
  94.       INTEGER cwin
  95.       RECORD /grstype/ grstat(1:10)
  96.       COMMON /GrAttr/ grstat, cwin
  97.       IF (x .LE. grstat(cwin).plotclip.right .AND.
  98.      +    x .GE. grstat(cwin).plotclip.left) THEN
  99.         CALL moveworldabs(x, y)
  100.         CALL lineworldabs(x, y - l)
  101.       END IF
  102.       END !SUBROUTINE
  103.  
  104.  
  105.  
  106.       SUBROUTINE DrawTicY (x, y, l)
  107.       REAL x, y, l
  108.       INCLUDE 'GRAFTYPE.FOR'
  109.       INTEGER cwin
  110.       RECORD /grstype/ grstat(1:10)
  111.       COMMON /GrAttr/ grstat, cwin
  112.  
  113.       IF (y .LE. grstat(cwin).plotclip.top .AND.
  114.      +    y .GE. grstat(cwin).plotclip.bottom) THEN
  115.         CALL moveworldabs(x, y)
  116.         CALL lineworldabs(x - l, y)
  117.       END IF
  118.       END !SUBROUTINE
  119.  
  120.  
  121.       SUBROUTINE DrLinXAx (TicSpace, dir)
  122.       INCLUDE 'GRAFTYPE.FOR'
  123.       REAL TicSpace, tl, xx1, ticlen
  124.       INTEGER dir, cwin
  125.       RECORD /grstype/ grstat(1:10)
  126.       COMMON /GrAttr/ grstat, cwin
  127.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  128.       CALL moveworldabs(grstat(cwin).plotclip.left,
  129.      +                   grstat(cwin).yint)
  130.       CALL lineworldabs(grstat(cwin).plotclip.right,
  131.      +                   grstat(cwin).yint)
  132.       grstat(cwin).numticx = NINT((grstat(cwin).plotclip.right -
  133.      +                   grstat(cwin).plotclip.left) / TicSpace)
  134.       grstat(cwin).ticspacex = TicSpace
  135.  
  136.       xx1 = grstat(cwin).xint + grstat(cwin).ticspacex
  137.       tl = 0.015 * (grstat(cwin).plotclip.top -
  138.      +              grstat(cwin).plotclip.bottom)
  139.       IF (dir .EQ. 0) THEN
  140.         ticlen = tl
  141.       ELSE
  142.         ticlen = -tl
  143.       END IF
  144.       DO WHILE (xx1 .LE. grstat(cwin).plotclip.right)
  145.         CALL DrawTicX(xx1, grstat(cwin).yint, ticlen)
  146.         xx1 = xx1 + grstat(cwin).ticspacex
  147.       END DO
  148.       xx1 = grstat(cwin).xint - grstat(cwin).ticspacex
  149.       DO WHILE (xx1 .GE. grstat(cwin).plotclip.left)
  150.         CALL DrawTicX(xx1, grstat(cwin).yint, ticlen)
  151.         xx1 = xx1 - grstat(cwin).ticspacex
  152.       END DO
  153.       END !SUBROUTINE
  154.  
  155.  
  156.  
  157.       SUBROUTINE DrLinYAx (TicSpace, dir)
  158.       INCLUDE 'GRAFTYPE.FOR'
  159.       INTEGER dir, cwin
  160.       REAL TicSpace, tl, yy1, ticlen
  161.       RECORD /grstype/ grstat(1:10)
  162.       COMMON /GrAttr/ grstat, cwin
  163.  
  164.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  165.       CALL moveworldabs(grstat(cwin).xint,
  166.      +                  grstat(cwin).plotclip.bottom)
  167.       CALL lineworldabs(grstat(cwin).xint,
  168.      +                  grstat(cwin).plotclip.top)
  169.       grstat(cwin).numticy = NINT((grstat(cwin).plotclip.top -
  170.      +                  grstat(cwin).plotclip.bottom) / TicSpace)
  171.       grstat(cwin).ticspacey = TicSpace
  172.       yy1 = grstat(cwin).yint + grstat(cwin).ticspacey
  173.       tl = 0.01 * (grstat(cwin).plotclip.right -
  174.      +            grstat(cwin).plotclip.left)
  175.       IF (dir .EQ. 0 ) THEN
  176.         ticlen = tl
  177.       ELSE
  178.         ticlen = -tl
  179.       END IF
  180.       DO WHILE (yy1 .LE. grstat(cwin).plotclip.top)
  181.         CALL DrawTicY(grstat(cwin).xint, yy1, ticlen)
  182.         yy1 = yy1 + grstat(cwin).ticspacey
  183.       END DO
  184.       yy1 = grstat(cwin).yint - grstat(cwin).ticspacey
  185.       DO WHILE (yy1 .GE. grstat(cwin).plotclip.bottom)
  186.         CALL DrawTicY(grstat(cwin).xint, yy1, ticlen)
  187.         yy1 = yy1 - grstat(cwin).ticspacey
  188.       END DO
  189.       END !SUBROUTINE
  190.  
  191.  
  192.  
  193.  
  194.       SUBROUTINE DrLogXAx (dir)
  195.       INCLUDE 'GRAFTYPE.FOR'
  196.       REAL tl1, tl2, xx1, yy1, ticlen,mts,LogSCFactor(1:10)
  197.       INTEGER dir, i, j, XLogMin, XLogMax, cwin
  198.       COMMON /LogSC/ LogSCFactor
  199.       RECORD /grstype/ grstat(1:10)
  200.       COMMON /GrAttr/ grstat, cwin
  201.  
  202.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  203.       CALL moveworldabs(grstat(cwin).plotclip.left,
  204.      +                  grstat(cwin).plotclip.bottom)
  205.       CALL lineworldabs(grstat(cwin).plotclip.right,
  206.      +                  grstat(cwin).plotclip.bottom)
  207.       XLogMin = NumExp(grstat(cwin).plotclip.left)
  208.       XLogMax = NumExp(grstat(cwin).plotclip.right)
  209.       grstat(cwin).numticx = XLogMax - XLogMin
  210.       mts = (grstat(cwin).plotclip.right -
  211.      +     grstat(cwin).plotclip.left) / REAL(grstat(cwin).numticx)
  212.       grstat(cwin).ticspacex = mts
  213.       tl1 = 0.015 * (grstat(cwin).plotclip.top -
  214.      +       grstat(cwin).plotclip.bottom)
  215.       tl2 = 2 * tl1
  216.       DO i = 0, grstat(cwin).numticx - 1
  217.         DO j = 1, 10
  218.           xx1 = grstat(cwin).plotclip.left + i * mts +
  219.      +           LogSCFactor(j) * mts
  220.           yy1 = grstat(cwin).plotclip.bottom
  221.           IF (MOD(j, 9) .EQ. 1) THEN
  222.             ticlen = tl2
  223.           ELSE
  224.             ticlen = tl1
  225.           END IF
  226.           IF (dir .EQ. 1)   ticlen = -ticlen
  227.           CALL DrawTicX(xx1, yy1, ticlen)
  228.         END DO
  229.       END DO
  230.       END !SUBROUTINE
  231.  
  232.  
  233.  
  234.       SUBROUTINE DrLogYAx (dir)
  235.       INCLUDE 'GRAFTYPE.FOR'
  236.       REAL tl1, tl2, xx1, yy1, ticlen,mts, LogSCFactor(1:10)
  237.       INTEGER i, j, YLogMin, YLogMax, dir ,cwin
  238.       COMMON /LogSC/ LogSCFactor
  239.       RECORD /grstype/ grstat(1:10)
  240.       COMMON /GrAttr/ grstat, cwin
  241.  
  242.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  243.       CALL moveworldabs(grstat(cwin).plotclip.left,
  244.      +                  grstat(cwin).plotclip.bottom)
  245.       CALL lineworldabs(grstat(cwin).plotclip.left,
  246.      +                  grstat(cwin).plotclip.top)
  247.       YLogMin = NumExp(grstat(cwin).plotclip.bottom)
  248.       YLogMax = NumExp(grstat(cwin).plotclip.top)
  249.       grstat(cwin).numticy = YLogMax - YLogMin
  250.       mts = (grstat(cwin).plotclip.top -
  251.      +       grstat(cwin).plotclip.bottom) /
  252.      +       REAL( grstat(cwin).numticy)
  253.       grstat(cwin).ticspacey = mts
  254.       tl1 = 0.01 * (grstat(cwin).plotclip.right -
  255.      +       grstat(cwin).plotclip.left)
  256.       tl2 = 2 * tl1
  257.       DO i = 0, grstat(cwin).numticy - 1
  258.         DO j = 1, 10
  259.           yy1 = grstat(cwin).plotclip.bottom + i * mts +
  260.      +          LogSCFactor(j) * mts
  261.           xx1 = grstat(cwin).plotclip.left
  262.           IF (MOD(j, 9) .EQ. 1) THEN
  263.             ticlen = tl2
  264.           ELSE
  265.             ticlen = tl1
  266.           END IF
  267.           IF (dir .EQ. 1) ticlen = -ticlen
  268.           CALL DrawTicY(xx1, yy1, ticlen)
  269.        END DO
  270.       END DO
  271.       END !SUBROUTINE
  272.  
  273.  
  274.  
  275.  
  276.  
  277.       SUBROUTINE DrXLinGrid (NthTic)
  278.       INCLUDE 'GRAFTYPE.FOR'
  279.       INTEGER NthTic, cwin
  280.       RECORD /grstype/ grstat(1:10)
  281.       COMMON /GrAttr/ grstat, cwin
  282.       REAL xx1, yy1, yy2
  283.  
  284.       grstat(cwin).tsx = grstat(cwin).ticspacex * NthTic
  285.       xx1 = grstat(cwin).xint + grstat(cwin).tsx
  286.       yy1 = grstat(cwin).plotclip.bottom
  287.       yy2 = grstat(cwin).plotclip.top
  288.       DO WHILE (xx1 .LE. grstat(cwin).plotclip.right )
  289.         CALL moveworldabs(xx1, yy1)
  290.         CALL lineworldabs(xx1, yy2)
  291.         xx1 = xx1 + grstat(cwin).tsx
  292.       END DO
  293.       xx1 = grstat(cwin).xint - grstat(cwin).tsx
  294.       DO WHILE (xx1 .GE. grstat(cwin).plotclip.left)
  295.         CALL moveworldabs(xx1, yy1)
  296.         CALL lineworldabs(xx1, yy2)
  297.         xx1 = xx1 - grstat(cwin).tsx
  298.       END DO
  299.       END !SUBROUTINE
  300.  
  301.  
  302.  
  303.  
  304.  
  305.       SUBROUTINE DrXLogGrid (NthTic)
  306.       INCLUDE 'GRAFTYPE.FOR'
  307.       INTEGER NthTic, i, cwin
  308.       REAL xx1, yy1, yy2
  309.       RECORD /grstype/ grstat(1:10)
  310.       COMMON /GrAttr/ grstat, cwin
  311.  
  312.       yy1 = grstat(cwin).plotclip.bottom
  313.       yy2 = grstat(cwin).plotclip.top
  314.       grstat(cwin).tsx = grstat(cwin).ticspacex * NthTic
  315.       xx1 = grstat(cwin).xint + grstat(cwin).tsx
  316.       DO i = 0, grstat(cwin).numticx - 1
  317.         CALL moveworldabs(xx1, yy1)
  318.         CALL lineworldabs(xx1, yy2)
  319.         xx1 = xx1 + grstat(cwin).tsx
  320.       END DO
  321.       END !SUBROUTINE
  322.  
  323.  
  324.  
  325.  
  326.  
  327.       SUBROUTINE DrYLinGrid (NthTic)
  328.       INCLUDE 'GRAFTYPE.FOR'
  329.       INTEGER NthTic, cwin
  330.       REAL xx1, xx2, yy1
  331.       RECORD /grstype/ grstat(1:10)
  332.       COMMON /GrAttr/ grstat, cwin
  333.  
  334.       grstat(cwin).tsy = grstat(cwin).ticspacey * NthTic
  335.       xx1 = grstat(cwin).plotclip.left
  336.       xx2 = grstat(cwin).plotclip.right
  337.       yy1 = grstat(cwin).yint + grstat(cwin).tsy
  338.       DO WHILE (yy1 .LE. grstat(cwin).plotclip.top)
  339.         CALL moveworldabs(xx1, yy1)
  340.         CALL lineworldabs(xx2, yy1)
  341.         yy1 = yy1 + grstat(cwin).tsy
  342.       END DO
  343.       yy1 = grstat(cwin).yint - grstat(cwin).tsy
  344.       DO WHILE (yy1 .GE. grstat(cwin).plotclip.bottom)
  345.         CALL moveworldabs(xx1, yy1)
  346.         CALL lineworldabs(xx2, yy1)
  347.         yy1 = yy1 - grstat(cwin).tsy
  348.       END DO
  349.       END !SUBROUTINE
  350.  
  351.  
  352.  
  353.       SUBROUTINE DrYLogGrid (NthTic)
  354.       INCLUDE 'GRAFTYPE.FOR'
  355.       INTEGER NthTic, i, cwin
  356.       REAL xx1, xx2, yy1
  357.       RECORD /grstype/ grstat(1:10)
  358.       COMMON /GrAttr/ grstat, cwin
  359.  
  360.       xx1 = grstat(cwin).plotclip.left
  361.       xx2 = grstat(cwin).plotclip.right
  362.       grstat(cwin).tsy = grstat(cwin).ticspacey * NthTic
  363.       yy1 = grstat(cwin).yint + grstat(cwin).tsy
  364.       DO i = 0, grstat(cwin).numticy - 1
  365.         CALL moveworldabs(xx1, yy1)
  366.         CALL lineworldabs(xx2, yy1)
  367.         yy1 = yy1 + grstat(cwin).tsy
  368.       END DO
  369.       END !SUBROUTINE
  370.  
  371.       FUNCTION exp10 (e)
  372.       INTEGER  e, i
  373.       REAL x
  374.  
  375.       x = 1.0
  376.       IF (e .GT. 0) THEN
  377.         DO i = 1, e
  378.           x = x * 10.0
  379.         END DO
  380.       ELSE
  381.         DO i = 1, -e, -1
  382.           x = x / 10.0
  383.         END DO
  384.         exp10 = x
  385.       END IF
  386.       END !FUNCTION
  387.  
  388.  
  389.       INTEGER FUNCTION NumExp (realnum)
  390.  
  391.       REAL realnum
  392.       if (ABS(realnum) .LT. 1.0e-16)  realnum = 1.0e-16
  393.       NumExp = INT(xlog10(ABS(realnum)))
  394.       RETURN
  395.       END !FUNCTION
  396.  
  397.       FUNCTION PowerCalc (realnum, power)
  398.       REAL realnum, power
  399.  
  400.         PowerCalc = EXP(power * LOG(realnum))
  401.       RETURN
  402.       END !FUNCTION
  403.  
  404.  
  405.  
  406.       SUBROUTINE LabelTicX (x, y, xval, lf, dir)
  407.       INCLUDE 'GRAFTYPE.FOR'
  408.       REAL x,y,xval
  409.       INTEGER  dir, cwin, i
  410.       LOGICAL lf
  411.       CHARACTER * 80  labvalstr
  412.       RECORD /grstype/ grstat(1:10)
  413.       COMMON /GrAttr/ grstat, cwin
  414.  
  415.       DO i = 1, 80
  416.         labvalstr(i:i) = ' '
  417.       END DO
  418.       CALL ConvertNum(xval, grstat(cwin).plotclip.left,
  419.      +              grstat(cwin).plotclip.right, grstat(cwin).tsx,
  420.      +              lf, labvalstr)
  421.       CALL LabelTicXString(x, y, labvalstr, dir)
  422.       END !SUBROUTINE
  423.  
  424.  
  425.  
  426.       SUBROUTINE LabelTicXString (x, y, TicLabel, dir)
  427.       INCLUDE 'GRAFTYPE.FOR'
  428.       REAL x,y, tl, xx1, yy1
  429.       INTEGER  dir, cwin
  430.       CHARACTER * 80 TicLabel
  431.       RECORD /grstype/ grstat(1:10)
  432.       COMMON /GrAttr/ grstat, cwin
  433.  
  434.       IF (x .LE. grstat(cwin).plotclip.right .AND.
  435.      +    x .GE. grstat(cwin).plotclip.left)  THEN
  436.         tl = 0.03 * (grstat(cwin).plotclip.top -
  437.      +              grstat(cwin).plotclip.bottom)
  438.         IF (dir .EQ. 0) THEN
  439.           CALL DrawTicX(x, y, tl)
  440.         ELSE
  441.            CALL DrawTicX(x, y, -tl)
  442.         END IF
  443.         tl = 0.040 * (grstat(cwin).plotclip.top -
  444.      +               grstat(cwin).plotclip.bottom)
  445.         IF (dir .EQ. 0) THEN
  446.           yy1 = y - tl
  447.         ELSE
  448.           yy1 = y + tl
  449.         END IF
  450.         xx1 = x
  451.         CALL moveworldabs(xx1, yy1)
  452.         CALL OutRealXX(TicLabel)
  453.       END IF
  454.       END !SUBROUTINE
  455.  
  456.  
  457.  
  458.       SUBROUTINE LabelTicY (x, y, yval, lf, dir)
  459.       INCLUDE 'GRAFTYPE.FOR'
  460.       REAL x,y
  461.       INTEGER  dir, cwin
  462.       LOGICAL lf
  463.       CHARACTER * 80  labvalstr
  464.       RECORD /grstype/ grstat(1:10)
  465.       COMMON /GrAttr/ grstat, cwin
  466.  
  467.       CALL ConvertNum(yval, grstat(cwin).plotclip.bottom,
  468.      +     grstat(cwin).plotclip.top, grstat(cwin).tsy, lf, labvalstr)
  469.       CALL LabelTicYString(x, y, labvalstr, dir)
  470.       END !SUBROUTINE
  471.  
  472.  
  473.       SUBROUTINE LabelTicYString (xx, yy, TicLabel, dir)
  474.       INCLUDE 'GRAFTYPE.FOR'
  475.       REAL xx,yy,  tl, xx1, yy1
  476.       INTEGER  dir, cwin
  477.       CHARACTER * 80 TicLabel
  478.       RECORD /grstype/ grstat(1:10)
  479.       COMMON /GrAttr/ grstat, cwin
  480.  
  481.       IF ((yy .LE. grstat(cwin).plotclip.top) .AND.
  482.      +    (yy .GE. grstat(cwin).plotclip.bottom)) THEN
  483.         tl = 0.015 * (grstat(cwin).plotclip.right -
  484.      +               grstat(cwin).plotclip.left)
  485.         IF (dir .EQ. 0) THEN
  486.           CALL DrawTicY(xx, yy, tl)
  487.         ELSE
  488.           CALL DrawTicY(xx, yy, -tl)
  489.         END IF
  490.         tl = 0.02 * (grstat(cwin).plotclip.right -
  491.      +              grstat(cwin).plotclip.left)
  492.         yy1 = yy
  493.         IF (dir .EQ. 0) THEN
  494.           xx1 = xx - tl
  495.         ELSE
  496.           xx1 = xx + tl
  497.         END IF
  498.         CALL moveworldabs(xx1, yy1)
  499.        CALL OutRealXX(TicLabel)
  500.       END IF
  501.       END !SUBROUTINE
  502.  
  503.  
  504.  
  505.       SUBROUTINE LabLinXAx (NthTic, dir)
  506.       INCLUDE 'GRAFTYPE.FOR'
  507.       INTEGER NthTic,dir, cwin
  508.       REAL xx1
  509.       RECORD /grstype/ grstat(1:10)
  510.       COMMON /GrAttr/ grstat, cwin
  511.  
  512.       grstat(cwin).tsx = grstat(cwin).ticspacex * REAL(NthTic)
  513.       xx1 = grstat(cwin).xint
  514.       IF (dir .EQ. 0) THEN
  515.         IF (grstat(cwin).yint .NE. grstat(cwin).plotclip.bottom)
  516.      +     xx1 = xx1 + grstat(cwin).tsx
  517.       ELSE
  518.         IF (grstat(cwin).yint .NE. grstat(cwin).plotclip.top)
  519.      +     xx1 = xx1 + grstat(cwin).tsx
  520.       END IF
  521.       DO WHILE (xx1 .LE. grstat(cwin).plotclip.right)
  522.         CALL LabelTicX(xx1, grstat(cwin).yint, xx1, .FALSE., dir)
  523.         xx1 = xx1 + grstat(cwin).tsx
  524.       END DO
  525.       xx1 = grstat(cwin).xint - grstat(cwin).tsx
  526.       DO WHILE ( xx1 .GE. grstat(cwin).plotclip.left )
  527.         CALL LabelTicX(xx1, grstat(cwin).yint, xx1, .FALSE., dir)
  528.         xx1 = xx1 - grstat(cwin).tsx
  529.       END DO
  530.       END !SUBROUTINE
  531.  
  532.  
  533.  
  534.  
  535.       SUBROUTINE LabLinYAx (NthTic, dir)
  536.       INCLUDE 'GRAFTYPE.FOR'
  537.       INTEGER NthTic,dir, cwin
  538.       REAL  yy1
  539.       RECORD /grstype/ grstat(1:10)
  540.       COMMON /GrAttr/ grstat, cwin
  541.  
  542.       grstat(cwin).tsy = grstat(cwin).ticspacey * REAL(NthTic)
  543.       yy1 = grstat(cwin).yint
  544.       IF (dir .EQ. 0) THEN
  545.         IF (grstat(cwin).xint .NE. grstat(cwin).plotclip.left)
  546.      +       yy1 = yy1 + grstat(cwin).tsy
  547.       ELSE
  548.         IF (grstat(cwin).xint .NE. grstat(cwin).plotclip.right)
  549.      +       yy1 = yy1 + grstat(cwin).tsy
  550.       END IF
  551.       DO WHILE (yy1 .LE. grstat(cwin).plotclip.top)
  552.         CALL LabelTicY(grstat(cwin).xint, yy1, yy1, .FALSE., dir)
  553.         yy1 = yy1 + grstat(cwin).tsy
  554.       END DO
  555.       yy1 = grstat(cwin).yint - grstat(cwin).tsy
  556.       DO WHILE (yy1 .GE. grstat(cwin).plotclip.bottom)
  557.         CALL LabelTicY(grstat(cwin).xint, yy1, yy1, .FALSE., dir)
  558.         yy1 = yy1 - grstat(cwin).tsy
  559.       END DO
  560.       END !SUBROUTINE
  561.  
  562.  
  563.  
  564.  
  565.       SUBROUTINE LabLogXAx (dir)
  566.       INCLUDE 'GRAFTYPE.FOR'
  567.       INTEGER dir, i, cwin
  568.       REAL xx1, labval
  569.       RECORD /grstype/ grstat(1:10)
  570.       COMMON /GrAttr/ grstat, cwin
  571.  
  572.       grstat(cwin).tsx = grstat(cwin).ticspacex
  573.       DO i = 0, grstat(cwin).numticx
  574.         xx1 = grstat(cwin).plotclip.left + i * grstat(cwin).tsx
  575.         labval = grstat(cwin).plotclip.left * PowerCalc(10.0, REAL(i))
  576.         CALL LabelTicX(xx1, grstat(cwin).yint, labval, .TRUE., dir)
  577.       END DO
  578.       END !SUBROUTINE
  579.  
  580.  
  581.  
  582.       SUBROUTINE LabLogYAx (dir)
  583.       INCLUDE 'GRAFTYPE.FOR'
  584.       INTEGER dir, i, cwin
  585.       REAL yy1, labval
  586.       RECORD /grstype/ grstat(1:10)
  587.       COMMON /GrAttr/ grstat, cwin
  588.  
  589.       grstat(cwin).tsy = grstat(cwin).ticspacey
  590.       DO i = 0, grstat(cwin).numticy
  591.         yy1 = grstat(cwin).plotclip.bottom + i * grstat(cwin).tsy
  592.         labval = grstat(cwin).plotclip.bottom * PowerCalc(10.0,REAL(i))
  593.         CALL LabelTicY(grstat(cwin).xint, yy1, labval, .TRUE., dir)
  594.       END DO
  595.       END !SUBROUTINE
  596.  
  597.       FUNCTION xlog10 (realnum)
  598.  
  599.       IF (realnum .LT. 1E-16) THEN
  600.         xlog10 = -16.0
  601.       ELSE
  602.         xlog10 = LOG10(realnum)
  603.       END IF
  604.       END !FUNCTION
  605.  
  606.  
  607.       SUBROUTINE ScaleLinY (yy1, yy2)
  608.       REAL yy1, yy2
  609.       INCLUDE 'GRAFTYPE.FOR'
  610.       INTEGER cwin
  611.       RECORD /grstype/ grstat(1:10)
  612.       COMMON /GrAttr/ grstat, cwin
  613.  
  614.       CALL SetGraphAreaWorld(grstat(cwin).plotclip.left, yy1,
  615.      +                       grstat(cwin).plotclip.right, yy2)
  616.       grstat(cwin).LogY = .FALSE.
  617.       END !SUBROUTINE
  618.  
  619.  
  620.  
  621.  
  622.       SUBROUTINE ScaleLogX (xx1,xx2)
  623.       REAL xx1, xx2, ex1, ex2
  624.       INCLUDE 'GRAFTYPE.FOR'
  625.       INTEGER cwin
  626.       RECORD /grstype/ grstat(1:10)
  627.       COMMON /GrAttr/ grstat, cwin
  628.  
  629.       xx2 = xx2 - xx2 / 10000.0
  630.       ex2 = NumExp(xx2) + 1
  631.       xx2 = PowerCalc(10.0, ex2)
  632.       xx1 = xx1 + xx1 / 10000.0
  633.       ex1 = NumExp(xx1)
  634.       IF (ex1 .LE. 0)  ex1 = ex1 - 1
  635.       xx1 = PowerCalc(10.0, ex1)
  636.       CALL SetGraphAreaWorld(xx1, grstat(cwin).plotclip.bottom,
  637.      +                       xx2, grstat(cwin).plotclip.top)
  638.       grstat(cwin).LogX = .TRUE.
  639.       END !SUBROUTINE
  640.  
  641.  
  642.  
  643.       SUBROUTINE ScaleLogY (yy1, yy2)
  644.       REAL yy1, yy2, ex1, ex2
  645.       INCLUDE 'GRAFTYPE.FOR'
  646.       INTEGER cwin
  647.       RECORD /grstype/ grstat(1:10)
  648.       COMMON /GrAttr/ grstat, cwin
  649.  
  650.       yy2 = yy2 - yy2 / 10000.0
  651.       ex2 = NumExp(yy2) + 1
  652.       yy2 = PowerCalc(10.0, ex2)
  653.       yy1 = yy1 + yy1 / 10000.0
  654.       ex1 = NumExp(yy1)
  655.       IF (ex1 .LE. 0) ex1 = ex1 - 1
  656.       yy1 = PowerCalc(10.0, ex1)
  657.       CALL SetGraphAreaWorld(grstat(cwin).plotclip.left, yy1,
  658.      +                       grstat(cwin).plotclip.right, yy2)
  659.       grstat(cwin).LogY = .TRUE.
  660.       END !SUBROUTINE
  661.  
  662.  
  663.       SUBROUTINE SetGraphAreaWorld (x1, y1, x2, y2)
  664.       REAL x1, y1, x2, y2
  665.       INCLUDE 'GRAFTYPE.FOR'
  666.       INTEGER cwin
  667.       RECORD /grstype/ grstat(1:10)
  668.       COMMON /GrAttr/ grstat, cwin
  669.  
  670.       grstat(cwin).plotworld.left = x1 - (x2 - x1) *
  671.      +   (grstat(cwin).win2plotratio.left / (1.0 -
  672.      +   (grstat(cwin).win2plotratio.left +
  673.      +    grstat(cwin).win2plotratio.right)))
  674.       grstat(cwin).plotworld.bottom = y1 - (y2 - y1) *
  675.      +   (grstat(cwin).win2plotratio.bottom / (1.0 -
  676.      +   (grstat(cwin).win2plotratio.bottom +
  677.      +    grstat(cwin).win2plotratio.top)))
  678.       grstat(cwin).plotworld.right = x2 + (x2 - x1) *
  679.      +   (grstat(cwin).win2plotratio.right / (1.0 -
  680.      +   (grstat(cwin).win2plotratio.right +
  681.      +    grstat(cwin).win2plotratio.left)))
  682.       grstat(cwin).plotworld.top = y2 + (y2 - y1) *
  683.      +   (grstat(cwin).win2plotratio.top / (1.0 -
  684.      +   (grstat(cwin).win2plotratio.top +
  685.      +   grstat(cwin).win2plotratio.bottom)))
  686.  
  687.       CALL SetWorldRect(grstat(cwin).plotclip, x1, y1, x2, y2)
  688.       END !SUBROUTINE
  689.  
  690.  
  691.       ! 5/2/90 Changed Log10 function to xlog10 function