home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l292 / 1.ddi / SEGRAPH.FOR < prev    next >
Encoding:
Text File  |  1990-05-02  |  50.1 KB  |  1,630 lines
  1.       SUBROUTINE AutoAxes (datasetx, datasety, numdat, AxFlag)
  2.       INCLUDE 'GRAFTYPE.FOR'
  3.       INCLUDE 'STDHDR.FOR'
  4.       INTEGER cwin,numdat, AxFlag, dirx, diry, lsx, lsy
  5.       RECORD /grstype/ grstat(1:10)
  6.       COMMON /GrAttr/ grstat, cwin
  7.       REAL datasetx(0:maxv), datasety(0:maxv), VerySmall
  8.       REAL xx1, yy1, xx2, yy2, ts1, ts2, xi, yi
  9.       PARAMETER ( VerySmall = 1E-10)
  10.  
  11.       dirx = 0
  12.       diry = 0
  13.       CALL FindMinMax(datasetx, numdat, xx1, xx2)
  14.       CALL FindMinMax(datasety, numdat, yy1, yy2)
  15.       IF (.NOT. grstat(cwin).LogX)  CALL RoundAxes(xx1, xx2, ts1)
  16.       IF (.NOT. grstat(cwin).LogY)  CALL RoundAxes(yy1, yy2, ts2)
  17.       IF (AxFlag .EQ. 0) THEN
  18.         IF (.NOT. grstat(cwin).LogX) THEN
  19.           IF (xx2 .GE. 0.0 .AND. xx1 .GE. 0.0) xi = xx1
  20.           IF (xx2 .GE. 0.0 .AND. xx1 .LT. 0.0) xi = 0.0
  21.           IF (xx2 .LE. 0.0 .AND. xx1 .LE. 0.0) THEN
  22.             xi = xx2
  23.             diry = 1
  24.           END IF
  25.         END IF
  26.         IF (.NOT. grstat(cwin).LogY) THEN
  27.           IF (yy2 .GE. 0.0 .AND. yy1 .GE. 0.0)  yi = yy1
  28.           IF (yy2 .GE. 0.0 .AND. yy1 .LT. 0.0)  yi = 0.0
  29.           IF (yy2 .LE. 0.0 .AND. yy1 .LE. 0.0) THEN
  30.             yi = yy2
  31.             dirx = 1
  32.           END IF
  33.         END IF
  34.       ELSE
  35.         xi = xx1
  36.         yi = yy1
  37.       END IF
  38.       grstat(cwin).yint = yi
  39.       grstat(cwin).xint = xi
  40.       CALL ScalePlotArea(xx1, yy1, xx2, yy2)
  41.       IF (grstat(cwin).LogX)
  42.      +    grstat(cwin).xint = grstat(cwin).plotclip.left
  43.       IF (grstat(cwin).LogY)
  44.      +   grstat(cwin).yint = grstat(cwin).plotclip.bottom
  45.       CALL SetXYIntercepts(grstat(cwin).xint, grstat(cwin).yint)
  46.       CALL DrawYAxis(ts2, diry)
  47.       CALL DrawXAxis(ts1, dirx)
  48.       IF (grstat(cwin).plotrect.right -
  49.      +      grstat(cwin).plotrect.left .GT. 350) THEN
  50.         lsx = 10
  51.       ELSE
  52.         lsx = 20
  53.       END IF
  54.       IF (ABS(grstat(cwin).plotrect.top -
  55.      +          grstat(cwin).plotrect.bottom) .LT. 75) THEN
  56.         lsy = 20
  57.       ELSE
  58.         lsy = 10
  59.       END IF
  60.       CALL LabelYAxis(lsy, diry)
  61.       CALL LabelXAxis(lsx, dirx)
  62.       END !SUBROUTINE
  63.  
  64.  
  65.  
  66.  
  67.  
  68.       SUBROUTINE BarGraphData (datasetx, datasety, numdat,
  69.      +                         barwid, newcolor, Hatchstyle)
  70.       INCLUDE 'GRAFTYPE.FOR'
  71.       INCLUDE 'STDHDR.FOR'
  72.       INTEGER cwin, numdat, newcolor, hatchstyle, i, OldColor, iErr
  73.       RECORD /grstype/ grstat(1:10)
  74.       COMMON /GrAttr/ grstat, cwin
  75.       REAL datasetx(0:maxv), datasety(0:maxv), barwid
  76.       REAL xx1, yy1, yy2
  77.       REAL tx[ALLOCATABLE](:),ty[ALLOCATABLE](:)
  78.  
  79.       ALLOCATE(tx(0:maxV),ty(0:maxV),STAT=iErr)
  80.       CALL CheckMem(iErr)
  81.  
  82.       CALL GetColXX(OldColor)
  83.       CALL SetFillStyleXX(Hatchstyle, newcolor)
  84.       CALL CopyVectors(datasetx, tx, numdat)
  85.       CALL CopyVectors(datasety, ty, numdat)
  86.       CALL PrePlot(tx, ty, numdat)
  87.       CALL moveworldabs(tx(0), ty(0))
  88.       IF (grstat(cwin).plotclip.top .GE. 0.0 .AND.
  89.      +   grstat(cwin).plotclip.bottom .GE. 0.0)
  90.      +    yy1 = grstat(cwin).plotclip.bottom
  91.       IF (grstat(cwin).plotclip.top .GE. 0.0 .AND.
  92.      +    grstat(cwin).plotclip.bottom .LT. 0.0)    yy1 = 0.0
  93.       IF (grstat(cwin).plotclip.top .LE. 0.0 .AND.
  94.      +    grstat(cwin).plotclip.bottom .LE. 0.0 )
  95.      +    yy1 = grstat(cwin).plotclip.top
  96.       IF (grstat(cwin).LogX)   barwid =
  97.      +    (log10(grstat(cwin).plotclip.right) -
  98.      +    log10(grstat(cwin).plotclip.left)) / (numdat * 1.1)
  99.       IF (grstat(cwin).LogY)  yy1 = log10(yy1)
  100.       DO i = 0, numdat - 1
  101.         yy2 = ty(i)
  102.         xx1 = tx(i)
  103.         CALL BarWorld(xx1,yy1, yy2 - yy1, barwid, newcolor, Hatchstyle)
  104.       END DO
  105.       CALL PostPlot
  106.       CALL SelectColor(OldColor)
  107.       DEALLOCATE(tx,ty,STAT=iErr)
  108.       CALL CheckDealloc(iErr)
  109.       END !SUBROUTINE
  110.  
  111.  
  112.  
  113.  
  114.  
  115.       SUBROUTINE BorderCurrentWindow (c)
  116.       INTEGER c
  117.       INCLUDE 'GRAFTYPE.FOR'
  118.       INTEGER cwin
  119.       RECORD /grstype/ grstat(1:10)
  120.       COMMON /GrAttr/ grstat, cwin
  121.       CALL SelectColor(c)
  122.       CALL RectangleXX(1.0, 1.0,
  123.      +     grstat(cwin).drawingRect.right -
  124.      +     grstat(cwin).drawingRect.left - 1.0,
  125.      +     grstat(cwin).drawingRect.bottom -
  126.      +     grstat(cwin).drawingRect.top - 1.0)
  127.       END !SUBROUTINE
  128.  
  129.  
  130.  
  131.       SUBROUTINE CheckForContour (cm, j1, i1, j2, i2,
  132.      +            minX, xSpace, minY, ySpace, contourZ, x, y, found)
  133.       INCLUDE 'GRAFTYPE.FOR'
  134.       REAL cm(0:maxContourX,0:maxContourY)
  135.       REAL minX, xSpace, minY, ySpace, contourZ, x, y
  136.       INTEGER j1, i1, j2, i2
  137.       LOGICAL found
  138.       REAL deltaX, deltaY, deltaZ
  139.  
  140.       IF ((cm(i1, j1) .GE. contourZ .AND.
  141.      +    cm(i2, j2) .LE. contourZ) .OR.
  142.      +   (cm(i1, j1) .LE. contourZ .AND.
  143.      +    cm(i2, j2) .GE. contourZ)) THEN
  144.         found = .TRUE.
  145.       ELSE
  146.         found = .FALSE.
  147.       END IF
  148.  
  149.       IF (found) THEN
  150.         IF (j2 - j1 .EQ. 1) THEN
  151.           deltaX = xSpace
  152.         ELSEIF (j2 - j1 .EQ. -1) THEN
  153.           deltaX = -xSpace
  154.         ELSE
  155.           deltaX = 0.0
  156.         END IF
  157.  
  158.         IF (i2 - i1 .EQ. 1) THEN
  159.           deltaY = ySpace
  160.         ELSEIF (i2 - i1 .EQ. -1) THEN
  161.           deltaY = -ySpace
  162.         ELSE
  163.           deltaY = 0.0
  164.         END IF
  165.         deltaZ = cm(i2, j2) - cm(i1, j1)
  166.         x = minX + xSpace * j1 +
  167.      +      (contourZ - cm(i1, j1)) * (deltaX / deltaZ)
  168.         y = minY + ySpace * i1 +
  169.      +      (contourZ - cm(i1, j1)) * (deltaY / deltaZ)
  170.       END IF
  171.       END !FUNCTION
  172.  
  173.  
  174.  
  175.  
  176.  
  177.       SUBROUTINE ClearGraph
  178.       INCLUDE 'GRAFTYPE.FOR'
  179.       INTEGER cwin
  180.       RECORD /grstype/ grstat(1:10)
  181.       COMMON /GrAttr/ grstat, cwin
  182.  
  183.       CALL SetGraphViewport(grstat(cwin).plotrect.left + 1,
  184.      +    grstat(cwin).plotrect.top + 1,
  185.      +    grstat(cwin).plotrect.right - 1,
  186.      +    grstat(cwin).plotrect.bottom - 1)
  187.       CALL ClearViewportXX
  188.       CALL SetGraphViewport(grstat(cwin).drawingRect.left,
  189.      +    grstat(cwin).drawingRect.top,
  190.      +    grstat(cwin).drawingRect.right,
  191.      +    grstat(cwin).drawingRect.bottom)
  192.       END !SUBROUTINE
  193.  
  194.  
  195.  
  196.  
  197.       SUBROUTINE ClearWindow
  198.  
  199.       CALL ClearViewportXX
  200.       END !SUBROUTINE
  201.  
  202.  
  203.  
  204.       SUBROUTINE CloseSEGraphics
  205.  
  206.       CALL CloseGraphics
  207.       END !SUBROUTINE
  208.  
  209.  
  210.  
  211.  
  212.       SUBROUTINE ContourPlot (cm, rows, columns, contourInc,
  213.      +                        colorMap)
  214.       INCLUDE 'GRAFTYPE.FOR'
  215.       INTEGER cwin
  216.       RECORD /grstype/ grstat(1:10)
  217.       COMMON /GrAttr/ grstat, cwin
  218.  
  219.       REAL cm(0:maxContourX,0:maxContourY), contourInc
  220.       RECORD /GroupInfoRec/ colorMap(0:maxLegends)
  221.       INTEGER rows, columns
  222.       INTEGER i, j, k, contourCounter
  223.       RECORD /WorldRect/ wr
  224.       REAL minX, xSpace, minY, ySpace, contourValue
  225.       REAL minZ, maxZ, x(0: 3), y(0: 3)
  226.       LOGICAL contourFound(0: 3)
  227.  
  228.       minX = grstat(cwin).plotclip.left
  229.       xSpace = (grstat(cwin).plotclip.right -
  230.      +          grstat(cwin).plotclip.left) / REAL(columns - 1)
  231.       minY = grstat(cwin).plotclip.bottom
  232.       ySpace = (grstat(cwin).plotclip.top -
  233.      +          grstat(cwin).plotclip.bottom) /REAL (rows - 1)
  234.  
  235.       CALL SetWorldRect(wr, grstat(cwin).plotclip.left,
  236.      +    grstat(cwin).plotclip.bottom, grstat(cwin).plotclip.right,
  237.      +    grstat(cwin).plotclip.top)
  238.       CALL SetGraphViewport(grstat(cwin).plotrect.left,
  239.      +    grstat(cwin).plotrect.top, grstat(cwin).plotrect.right,
  240.      +    grstat(cwin).plotrect.bottom)
  241.       CALL SetWorldCoordinates(wr)
  242.       contourCounter = 0
  243.       CALL FindCMMInMax(cm, rows, columns, minZ, maxZ)
  244.       contourValue = minZ + contourInc
  245.       DO  WHILE  (contourValue .LT. maxZ)
  246.         CALL SelectColor(colorMap(contourCounter).GroupColor)
  247.         CALL SetLineStyleXX(colorMap(contourCounter).GroupHatch,1)
  248.         DO i = 0, rows - 2
  249.           DO j = 0, columns - 2
  250.       !!!top
  251.          CALL CheckForContour(cm, j, i, j + 1,i, minX, xSpace, minY,
  252.      +      ySpace, contourValue, x(0), y(0), contourFound(0))
  253.       !!!right
  254.          CALL CheckForContour(cm, j+1, i, j+1,i+1, minX, xSpace,minY,
  255.      +       ySpace, contourValue, x(1), y(1),contourFound(1))
  256.       !!!bottom
  257.            CALL CheckForContour(cm, j+1, i+1, j,i+1, minX, xSpace,minY,
  258.      +       ySpace, contourValue, x(2), y(2), contourFound(2))
  259.       !!!left
  260.            CALL CheckForContour(cm, j, i+1, j, i,minX, xSpace, minY,
  261.      +       ySpace, contourValue, x(3), y(3), contourFound(3))
  262.             numCountours = 0
  263.             DO k = 0, 3
  264.               IF (contourFound(k)) THEN
  265.                 x(numCountours) = x(k)
  266.                 y(numCountours) = y(k)
  267.                 numCountours = numCountours + 1
  268.               END IF
  269.             END DO
  270.             SELECT CASE (numCountours)
  271.               CASE (2)
  272.                    CALL moveworldabs(x(0), y(0))
  273.                    CALL lineworldabs(x(1), y(1))
  274.               CASE (3)
  275.                    CALL moveworldabs(x(0), y(0))
  276.                    CALL lineworldabs(x(2), y(2))
  277.               CASE (4)
  278.                    CALL moveworldabs(x(0), y(0))
  279.                    CALL lineworldabs(x(2), y(2))
  280.                    CALL moveworldabs(x(1), y(1))
  281.                    CALL lineworldabs(x(3), y(3))
  282.               CASE DEFAULT
  283.                   CALL moveworldabs(x(0), y(0))
  284.                   CALL lineworldabs(x(1), y(1))
  285.             END SELECT
  286.           END DO
  287.         END DO
  288.         contourValue = contourValue + contourInc
  289.         contourCounter = contourCounter + 1
  290.       END DO
  291.       CALL SetGraphViewport(grstat(cwin).drawingRect.left,
  292.      +      grstat(cwin).drawingRect.top,
  293.      +      grstat(cwin).drawingRect.right,
  294.      +      grstat(cwin).drawingRect.bottom)
  295.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  296.       END !SUBROUTINE
  297.  
  298.  
  299.  
  300.  
  301.  
  302.       SUBROUTINE ContourPlotLegends (cm, rows, columns, contourInc,
  303.      +                               colorMap )
  304.       INCLUDE 'GRAFTYPE.FOR'
  305.       INTEGER cwin
  306.       RECORD /grstype/ grstat(1:10)
  307.       COMMON /GrAttr/ grstat, cwin
  308.       REAL cm(0:maxcontourX, 0:maxcontourY),  contourInc
  309.       RECORD /GroupInfoRec/ colorMap(0:MaxLegends)
  310.       INTEGER rows, columns
  311.       REAL contourValue, minZ, maxZ,contourValues(0 : maxLegends)
  312.       INTEGER  i
  313.  
  314.       i = 0
  315.       CALL FindCMMInMax(cm, rows, columns, minZ, maxZ)
  316.       contourValue = minZ + contourInc
  317.       DO WHILE (contourValue .LT. maxZ)
  318.         contourValues(i) = contourValue
  319.         contourValue = contourValue + contourInc
  320.         i = i + 1
  321.       END DO
  322.       CALL RealLegends(contourValues, colorMap, i, 0)
  323.       END !SUBROUTINE
  324.  
  325.  
  326.  
  327.  
  328.  
  329.       SUBROUTINE CopyVectors (xin, xout, n)
  330.       INCLUDE 'STDHDR.FOR'
  331.       REAL xin(0:maxv), xout(0:maxv)
  332.       INTEGER n, i
  333.  
  334.       DO i = 0, n - 1
  335.         xout(i) = xin(i)
  336.       END DO
  337.       END !SUBROUTINE
  338.  
  339.  
  340.       SUBROUTINE Copy1to2D (xout, xin, numdat, numgroup)
  341.       INCLUDE 'STDHDR.FOR'
  342.       INCLUDE 'GRAFTYPE.FOR'
  343.       INTEGER  i
  344.       REAL xin(0:maxv)
  345.       REAL xout(0:maxgroup,0:maxv)
  346.  
  347.       DO i = 0, numdat - 1
  348.         xout(numgroup,i) = xin(i)
  349.       END DO
  350.       END !SUBROUTINE
  351.  
  352.       SUBROUTINE Copy2DVectors (xin, xout, numdat, numgroup)
  353.       INCLUDE 'STDHDR.FOR'
  354.       INCLUDE 'GRAFTYPE.FOR'
  355.       REAL xin(0:maxgroup, 0: maxv), xout(0:maxv)
  356.       INTEGER numdat, numgroup, i
  357.  
  358.        DO i = 0, numdat - 1
  359.           xout(i) = xin(numgroup,i)
  360.        END DO
  361.       END !SUBROUTINE
  362.  
  363.  
  364.  
  365.  
  366.  
  367.       SUBROUTINE DefGraphWindow (xx1, yy1, xx2, yy2, win)
  368.       INCLUDE 'GRAFTYPE.FOR'
  369.       INTEGER xx1, yy1, xx2, yy2, win, cwin
  370.       RECORD /grstype/ grstat(1:10)
  371.       COMMON /GrAttr/ grstat, cwin
  372.  
  373.       cwin = win
  374.       CALL SetAxesType(0, 0)
  375.       CALL SetRect(grstat(cwin).drawingRect, xx1, yy1, xx2, yy2)
  376.       grstat(cwin).plotrect.left = grstat(cwin).drawingRect.left +
  377.      +                    NINT((grstat(cwin).drawingRect.right -
  378.      +                          grstat(cwin).drawingRect.left) *
  379.      +                          grstat(cwin).win2plotratio.left)
  380.       grstat(cwin).plotrect.bottom = grstat(cwin).drawingRect.bottom
  381.      +                   - NINT((grstat(cwin).drawingRect.bottom -
  382.      +                   grstat(cwin).drawingRect.top) *
  383.      +                   grstat(cwin).win2plotratio.bottom)
  384.       grstat(cwin).plotrect.right = grstat(cwin).drawingRect.right -
  385.      +                  NINT((grstat(cwin).drawingRect.right -
  386.      +                  grstat(cwin).drawingRect.left) *
  387.      +                  grstat(cwin).win2plotratio.right)
  388.       grstat(cwin).plotrect.top = grstat(cwin).drawingRect.top +
  389.      +                  NINT((grstat(cwin).drawingRect.bottom -
  390.      +                  grstat(cwin).drawingRect.top) *
  391.      +                  grstat(cwin).win2plotratio.top)
  392.       CALL SetWorldRect(grstat(cwin).plotclip,0.0, 0.0,1000.0,1000.0)
  393.       CALL SetWorldRect(grstat(cwin).plotworld,0.0, 0.0,1000.0,1000.0)
  394.       CALL SetGraphAreaWorld(0.0, 0.0, 1000.0, 1000.0)
  395.       CALL SetGraphViewport(xx1, yy1, xx2, yy2)
  396.       END !SUBROUTINE
  397.  
  398.  
  399.  
  400.  
  401.       SUBROUTINE DrawGrid (NthTic)
  402.       INTEGER NthTic
  403.       INCLUDE 'GRAFTYPE.FOR'
  404.       INTEGER cwin
  405.       RECORD /grstype/ grstat(1:10)
  406.       COMMON /GrAttr/ grstat, cwin
  407.  
  408.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  409.       IF (grstat(cwin).LogX) THEN
  410.         CALL DrXLogGrid (NthTic)
  411.       ELSE
  412.         CALL DrXLinGrid (NthTic)
  413.       END IF
  414.       IF (grstat(cwin).LogY) THEN
  415.         CALL DrYLogGrid (NthTic)
  416.       ELSE
  417.         CALL DrYLinGrid (NthTic)
  418.       END IF
  419.       END !SUBROUTINE
  420.  
  421.  
  422.  
  423.       SUBROUTINE DrawGridX (NthTic)
  424.       INTEGER NthTic
  425.       INCLUDE 'GRAFTYPE.FOR'
  426.       INTEGER cwin
  427.       RECORD /grstype/ grstat(1:10)
  428.       COMMON /GrAttr/ grstat, cwin
  429.  
  430.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  431.       IF (grstat(cwin).LogX) THEN
  432.         CALL DrXLogGrid(NthTic)
  433.       ELSE
  434.         CALL DrXLinGrid(NthTic)
  435.       END IF
  436.       END !SUBROUTINE
  437.  
  438.  
  439.  
  440.       SUBROUTINE DrawGridY (NthTic)
  441.       INTEGER NthTic
  442.       INCLUDE 'GRAFTYPE.FOR'
  443.       INTEGER cwin
  444.       RECORD /grstype/ grstat(1:10)
  445.       COMMON /GrAttr/ grstat, cwin
  446.  
  447.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  448.       IF (grstat(cwin).LogY) THEN
  449.         CALL DrYLogGrid(NthTic)
  450.       ELSE
  451.         CALL DrYLinGrid(NthTic)
  452.       END IF
  453.       END !SUBROUTINE
  454.  
  455.  
  456.  
  457.  
  458.       SUBROUTINE DrawXAxis (TicSpace, dir)
  459.       REAL TicSpace
  460.       INTEGER dir
  461.       INCLUDE 'GRAFTYPE.FOR'
  462.       INTEGER cwin
  463.       RECORD /grstype/ grstat(1:10)
  464.       COMMON /GrAttr/ grstat, cwin
  465.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  466.       IF (grstat(cwin).LogX) THEN
  467.         CALL DrLogXAx(dir)
  468.       ELSE
  469.         CALL DrLinXAx(TicSpace, dir)
  470.       END IF
  471.       END !SUBROUTINE
  472.  
  473.       SUBROUTINE DrawYAxis (TicSpace, dir)
  474.       REAL TicSpace
  475.       INTEGER dir
  476.       INCLUDE 'GRAFTYPE.FOR'
  477.       INTEGER cwin
  478.       RECORD /grstype/ grstat(1:10)
  479.       COMMON /GrAttr/ grstat, cwin
  480.  
  481.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  482.       IF (grstat(cwin).LogY) THEN
  483.         CALL DrLogYAx(dir)
  484.       ELSE
  485.         CALL DrLinYAx(TicSpace, dir)
  486.       END IF
  487.       END !SUBROUTINE
  488.  
  489.  
  490.       SUBROUTINE FindCMMInMax (cm, rows, columns, minzval, maxzval)
  491.       INCLUDE 'GRAFTYPE.FOR'
  492.       REAL cm(0:maxcontourX, 0:maxcontourY)
  493.       INTEGER rows, columns
  494.       REAL minzval, maxzval
  495.       INTEGER i, j
  496.  
  497.       minzval = cm(0, 0)
  498.       maxzval = cm(0, 0)
  499.       DO i = 0, columns - 1
  500.         DO j = 0, rows - 1
  501.           IF (cm(i, j) .LT. minzval)  minzval = cm(i, j)
  502.           IF (cm(i, j) .GT. maxzval)  maxzval = cm(i, j)
  503.         END DO
  504.       END DO
  505.       END !SUBROUTINE
  506.  
  507.  
  508.  
  509.       SUBROUTINE FindMinMax (dataset, numdat, minval, maxval)
  510.       INCLUDE 'STDHDR.FOR'
  511.       REAL dataset(0:maxv), minval, maxval
  512.       INTEGER numdat, i
  513.  
  514.       minval = dataset(0)
  515.       maxval = dataset(0)
  516.       DO i = 0, numdat - 1
  517.         IF (dataset(i) .LT. minval)  minval = dataset(i)
  518.         IF (dataset(i) .GT. maxval)  maxval = dataset(i)
  519.       END DO
  520.       END !SUBROUTINE
  521.  
  522.  
  523.  
  524.  
  525.  
  526.       SUBROUTINE GroupPlotData (datasetx, GroupData,
  527.      +   numdat, numgroup, GraphType, barwid, fill)
  528.       INCLUDE 'GRAFTYPE.FOR'
  529.       INCLUDE 'STDHDR.FOR'
  530.       INTEGER cwin
  531.       RECORD /grstype/ grstat(1:10)
  532.       COMMON /GrAttr/ grstat, cwin
  533.       REAL datasetx(0:maxv), GroupData(0:maxgroup,0:maxv)
  534.       RECORD /GroupInfoRec/ fill( 0:maxgroup)
  535.       INTEGER numdat, numgroup, GraphType, i, j, OldColor, iErr
  536.       REAL barwid, xx1, yy1, xx2, yy2
  537.       REAL tx[ALLOCATABLE](:),SumVector[ALLOCATABLE](:)
  538.       REAL tempg[ALLOCATABLE](:), txg[ALLOCATABLE](:,:)
  539.  
  540.       ALLOCATE(tx(0:maxV),SumVector(0:maxV),tempg(0:maxv), STAT=iErr)
  541.       CALL CheckMem(iErr)
  542.       ALLOCATE(txg(0:maxgroup,0:maxv), STAT = iErr)
  543.       CALL CheckMem(iErr)
  544.  
  545.       CALL GetColXX(OldColor)
  546.       CALL CopyVectors(datasetx, tx, numdat)
  547.       IF (GraphType .LT. 0 .OR. GraphType .GT. 2) GraphType = 1
  548.       DO i = 0, numdat - 1
  549.         SumVector(i) = 0.0
  550.       END DO
  551.       DO i = 0, numgroup - 1
  552.         CALL Copy2DVectors(GroupData, tempg, numdat,i)
  553.         CALL PrePlot(tx, tempg, numdat)
  554.         Call Copy1to2D(txg,tempg,numdat,i)
  555.       END DO
  556.       SELECT CASE (GraphType)
  557.          CASE (0)
  558.           DO i = 0, numgroup - 1
  559.             DO j = 0, numdat - 1
  560.               SumVector(j) = SumVector(j) + txg(i,j)
  561.             END DO
  562.             CALL LinePlotData(tx, SumVector, numdat,
  563.      +            fill(i).GroupColor, fill(i).GroupHatch)
  564.           END DO
  565.          CASE (1)
  566.            DO j = 0, numdat - 1
  567.              xx1 = tx(j) - barwid / 2.0
  568.              xx2 = xx1 + barwid
  569.              DO i = 0, numgroup - 1
  570.               IF (grstat(cwin).plotclip.bottom .GE. SumVector(j)) THEN
  571.                 yy1 = grstat(cwin).plotclip.bottom
  572.               ELSE
  573.                 yy1 = SumVector(j)
  574.               END IF
  575.               SumVector(j) = SumVector(j) + txg(i,j)
  576.               yy2 = SumVector(j)
  577.               CALL SetFillStyleXX(fill(i).GroupHatch,
  578.      +                            fill(i).GroupColor)
  579.               CALL BarWorld(xx1, yy1, yy2 - yy1, xx2 - xx1,
  580.      +              fill(i).GroupColor, fill(i).GroupHatch)
  581.             END DO
  582.           END DO
  583.          CASE (2)
  584.           DO j = 0, numdat - 1
  585.             DO i = 0, numgroup - 1
  586.               xx1 = (tx(j) - barwid / 2.0) + i *
  587.      +              (barwid /REAL( numgroup))
  588.               xx2 = xx1 + barwid /REAL( numgroup)
  589.               IF (grstat(cwin).plotclip.top .GE. 0.0 .AND.
  590.      +           grstat(cwin).plotclip.bottom .GE. 0.0)
  591.      +            yy1 = grstat(cwin).plotclip.bottom
  592.               IF (grstat(cwin).plotclip.top .GE. 0.0 .AND.
  593.      +           grstat(cwin).plotclip.bottom .LT. 0.0)  yy1 = 0.0
  594.               IF (grstat(cwin).plotclip.top .LE. 0.0 .AND.
  595.      +           grstat(cwin).plotclip.bottom .LE. 0.0)
  596.      +              yy1 = grstat(cwin).plotclip.top
  597.               yy2 = txg(i,j)
  598.               CALL SetFillStyleXX(fill(i).GroupHatch,
  599.      +                            fill(i).GroupColor)
  600.               CALL BarWorld(xx1, yy1, yy2 - yy1, xx2 - xx1,
  601.      +               fill(i).GroupColor, fill(i).GroupHatch)
  602.             END DO
  603.           END DO
  604.       END SELECT
  605.       CALL PostPlot
  606.  
  607.       CALL SelectColor(OldColor)
  608.       DEALLOCATE(tx,SumVector,tempg,STAT=iErr)
  609.       CALL CheckDealloc(iErr)
  610.       DEALLOCATE(txg,STAT=iErr)
  611.       CALL CheckDealloc(iErr)
  612.       END !SUBROUTINE
  613.  
  614.       SUBROUTINE InitString( s)
  615.       INTEGER i
  616.       CHARACTER * 80 s
  617.       DO i = 1, 80
  618.         s(i:i) =  ' '
  619.       END DO
  620.       END !FUNCTION
  621.  
  622.  
  623.       SUBROUTINE InitSEGraphics (mode, fontpath )
  624.       INCLUDE 'GRAFTYPE.FOR'
  625.       INTEGER cwin, mode
  626.       RECORD /grstype/ grstat(1:10)
  627.       COMMON /GrAttr/ grstat, cwin
  628.       REAL LogSCFactor(1:10)
  629.       CHARACTER * (*) fontpath
  630.       COMMON /LogSC/ LogSCFactor
  631.  
  632.       LogSCFactor(1) = 0.0
  633.       LogSCFactor(2) = 0.301
  634.       LogSCFactor(3) = 0.4771
  635.       LogSCFactor(4) = 0.6021
  636.       LogSCFactor(5) = 0.699
  637.       LogSCFactor(6) = 0.7782
  638.       LogSCFactor(7) = 0.8451
  639.       LogSCFactor(8) = 0.9031
  640.       LogSCFactor(9) = 0.9542
  641.       LogSCFactor(10) = 1.0
  642.       CALL SetTextJustifyXX(0, 0)
  643.       CALL OneTimeInit (mode, fontpath)
  644.       DO i = 1, 10
  645.         CALL SetWorldRect(grstat(i).win2plotratio,
  646.      +                    0.166, 0.166, 0.166, 0.166)
  647.       END DO
  648.  
  649.       CALL SetPercentWindow(0.1, 0.1, 0.9, 0.9, 1)
  650.       CALL SetWin2PlotRatio(1, 0.19, 0.12, 0.05, 0.14)
  651.  
  652.       CALL SetPercentWindow(0.02, 0.02, 0.98, 0.98, 2)
  653.       CALL SetWin2PlotRatio(2, 0.19, 0.12, 0.05, 0.14)
  654.  
  655.       CALL SetPercentWindow(0.02, 0.02, 0.98, 0.49, 3)
  656.       CALL SetWin2PlotRatio(3, 0.19, 0.14, 0.05, 0.2)
  657.  
  658.       CALL SetPercentWindow(0.02, 0.51, 0.98, 0.98, 4)
  659.       CALL SetWin2PlotRatio(4, 0.19, 0.14, 0.05, 0.2)
  660.  
  661.       CALL SetPercentWindow(0.02, 0.02, 0.49, 0.98, 5)
  662.       CALL SetWin2PlotRatio(5, 0.23, 0.14, 0.06, 0.14)
  663.  
  664.       CALL SetPercentWindow(0.51, 0.02, 0.98, 0.98, 6)
  665.       CALL SetWin2PlotRatio(6, 0.23, 0.14, 0.06, 0.14)
  666.  
  667.       CALL SetPercentWindow(0.02, 0.02, 0.49, 0.49, 7)
  668.       CALL SetWin2PlotRatio(7, 0.23, 0.19, 0.08, 0.2)
  669.  
  670.       CALL SetPercentWindow(0.51, 0.02, 0.98, 0.49, 8)
  671.       CALL SetWin2PlotRatio(8, 0.23, 0.19, 0.08, 0.2)
  672.  
  673.       CALL SetPercentWindow(0.02, 0.51, 0.49, 0.98, 9)
  674.       CALL SetWin2PlotRatio(9, 0.23, 0.19, 0.08, 0.2)
  675.  
  676.       CALL SetPercentWindow(0.51, 0.51, 0.98, 0.98, 10)
  677.       CALL SetWin2PlotRatio(10, 0.23, 0.19, 0.08, 0.2)
  678.  
  679.  
  680.       CALL ScalePlotArea(0.0, 0.0, 100.0, 100.0)
  681.  
  682.       END !SUBROUTINE
  683.  
  684.  
  685.  
  686.       SUBROUTINE LabelGraphWindow (x, y, GrLabel, xjust, yjust)
  687.       INCLUDE 'GRAFTYPE.FOR'
  688.       INTEGER cwin,xjust, yjust
  689.       RECORD /grstype/ grstat(1:10)
  690.       COMMON /GrAttr/ grstat, cwin
  691.       REAL x,y
  692.       CHARACTER * (*) GrLabel
  693.       CHARACTER * 80 TempLabel
  694.       RECORD /WorldRect/ d
  695.  
  696.       CALL InitString(TempLabel )
  697.       TempLabel = GrLabel
  698.       CALL SetWorldRect(d, 0.0, 0.0, 1000.0, 1000.0)
  699.       CALL SetWorldCoordinates(d)
  700.       CALL SetTextJustifyXX(xjust, yjust)
  701.       CALL moveworldabs(x, y)
  702.       CALL OutTextXX( TempLabel)
  703.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  704.       CALL SetTextJustifyXX(lefttext, centertext)
  705.       END !SUBROUTINE
  706.  
  707.  
  708.  
  709.       SUBROUTINE LabelPlotArea (x, y, GrLabel, xjust, yjust)
  710.       REAL x, y, xx1, xx2, yy1, yy2
  711.       CHARACTER * (*) GrLabel
  712.       INCLUDE 'GRAFTYPE.FOR'
  713.       INTEGER cwin, xjust, yjust, i
  714.       RECORD /grstype/ grstat(1:10)
  715.       COMMON /GrAttr/ grstat, cwin
  716.       RECORD /WorldRect/ w1, w2, w3
  717.       CHARACTER * 80 TempLabel
  718.  
  719.       DO i = 1, 80
  720.         TempLabel(i:i) = ' '
  721.       END DO
  722.       TempLabel = GrLabel
  723.       w3 = grstat(cwin).plotworld
  724.       w2 = grstat(cwin).plotclip
  725.       IF (grstat(cwin).LogX) THEN
  726.         xx1 = log10(grstat(cwin).plotclip.left)
  727.         xx2 = log10(grstat(cwin).plotclip.right)
  728.         x = log10(x)
  729.       ELSE
  730.         xx1 = grstat(cwin).plotclip.left
  731.         xx2 = grstat(cwin).plotclip.right
  732.       END IF
  733.       IF (grstat(cwin).LogY) THEN
  734.         yy1 = log10(grstat(cwin).plotclip.bottom)
  735.         yy2 = log10(grstat(cwin).plotclip.top)
  736.         y = log10(y)
  737.       ELSE
  738.         yy1 = grstat(cwin).plotclip.bottom
  739.         yy2 = grstat(cwin).plotclip.top
  740.       END IF
  741.       CALL SetGraphViewport(grstat(cwin).plotrect.left,
  742.      +     grstat(cwin).plotrect.top, grstat(cwin).plotrect.right,
  743.      +     grstat(cwin).plotrect.bottom)
  744.       CALL SetWorldRect(w1, xx1, yy1, xx2, yy2)
  745.       CALL SetWorldCoordinates(w1)
  746.       CALL SetTextJustifyXX(xjust, yjust)
  747.       CALL moveworldabs(x, y)
  748.       CALL OutTextXX(TempLabel)
  749.       grstat(cwin).plotworld = w3
  750.       grstat(cwin).plotclip = w2
  751.       CALL SetGraphViewport(grstat(cwin).drawingRect.left,
  752.      +  grstat(cwin).drawingRect.top, grstat(cwin).drawingRect.right,
  753.      +  grstat(cwin).drawingRect.bottom)
  754.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  755.       CALL SetTextJustifyXX(0, 0)
  756.       END !SUBROUTINE
  757.  
  758.       SUBROUTINE LabelXAxis (NthTic, dir)
  759.       INCLUDE 'GRAFTYPE.FOR'
  760.       INTEGER cwin, NthTic, dir
  761.       RECORD /grstype/ grstat(1:10)
  762.       COMMON /GrAttr/ grstat, cwin
  763.  
  764.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  765.       IF (dir .EQ. 0) THEN
  766.         CALL SetTextJustifyXX(1, 2)
  767.       ELSE
  768.         CALL SetTextJustifyXX(1, 0)
  769.       END IF
  770.       IF (grstat(cwin).LogX) THEN
  771.         CALL LabLogXAx(dir)
  772.       ELSE
  773.         CALL LabLinXAx(NthTic, dir)
  774.       END IF
  775.       CALL SetTextJustifyXX(0, 0)
  776.       END !SUBROUTINE
  777.  
  778.       SUBROUTINE LabelXAxWithStrings (NthTic,TicStrings,NumStrings,dir)
  779.       INCLUDE 'GRAFTYPE.FOR'
  780.       REAL xx1
  781.       CHARACTER* 80 TicStrings(0:20)
  782.       INTEGER i, NthTic, NumStrings, dir, cwin
  783.       RECORD /grstype/ grstat(1:10)
  784.       COMMON /GrAttr/ grstat, cwin
  785.  
  786.       IF (dir .EQ. 0) THEN
  787.         CALL SetTextJustifyXX(1, 2)
  788.       ELSE
  789.         CALL SetTextJustifyXX(1, 0)
  790.       END IF
  791.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  792.       grstat(cwin).tsx = grstat(cwin).ticspacex * NthTic
  793.       xx1 = grstat(cwin).plotclip.left + grstat(cwin).tsx
  794.       DO i = 0, NumStrings - 1
  795.        CALL LabelTicXString(xx1, grstat(cwin).yint, TicStrings(i), dir)
  796.         xx1 = xx1 + grstat(cwin).tsx
  797.       END DO
  798.       CALL SetTextJustifyXX(0, 0)
  799.       END !SUBROUTINE
  800.  
  801.       SUBROUTINE LabelYAxis (NthTic, dir)
  802.       INCLUDE 'GRAFTYPE.FOR'
  803.       INTEGER cwin, NthTic, dir
  804.       RECORD /grstype/ grstat(1:10)
  805.       COMMON /GrAttr/ grstat, cwin
  806.  
  807.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  808.       IF (dir .EQ. 0) THEN
  809.         CALL SetTextJustifyXX(2, 1)
  810.       ELSE
  811.         CALL SetTextJustifyXX(0, 1)
  812.       END IF
  813.       IF (grstat(cwin).LogY) THEN
  814.         CALL LabLogYAx(dir)
  815.       ELSE
  816.         CALL LabLinYAx(NthTic, dir)
  817.       END IF
  818.       CALL SetTextJustifyXX(0, 0)
  819.       END !SUBROUTINE
  820.  
  821.  
  822.  
  823.       SUBROUTINE LinePlotData (datasetx, datasety,
  824.      +               numdat, newcolor, linestyle)
  825.       INCLUDE 'GRAFTYPE.FOR'
  826.       INCLUDE 'STDHDR.FOR'
  827.       REAL datasetx(0:maxv), datasety(0:maxv)
  828.       INTEGER cwin,numdat, newcolor, linestyle, OldColor, iErr
  829.       RECORD /grstype/ grstat(1:10)
  830.       COMMON /GrAttr/ grstat, cwin
  831.       REAL tx[ALLOCATABLE](:),ty[ALLOCATABLE](:)
  832.  
  833.  
  834.       ALLOCATE(tx(0:maxV),ty(0:maxV),STAT=iErr)
  835.       CALL CheckMem(iErr)
  836.  
  837.       CALL GetColXX(OldColor)
  838.       CALL SelectColor(newcolor)
  839.       CALL SetLineStyleXX(linestyle,  1)
  840.  
  841.       CALL CopyVectors(datasetx, tx, numdat)
  842.       CALL CopyVectors(datasety, ty, numdat)
  843.  
  844.       CALL PrePlot(tx, ty, numdat)
  845.       CALL polyLineWorldAbs(tx, ty, numdat)
  846.       CALL PostPlot
  847.  
  848.       CALL SetLineStyleXX(0, 1)
  849.       CALL SelectColor(OldColor)
  850.       DEALLOCATE(tx,ty,STAT=iErr)
  851.       CALL CheckDealloc(iErr)
  852.       END !SUBROUTINE
  853.  
  854.  
  855.  
  856.       SUBROUTINE PieChart (xdata, numgroup, gcolors,titles, pietype,
  857.      +                    PieVal, per, explode)
  858.       INCLUDE 'GRAFTYPE.FOR'
  859.       INCLUDE 'STDHDR.FOR'
  860.       REAL xw, yw, xdata(0:maxr),radius,Twopi360, xc, yc, sum, AspectR
  861.       REAL xcenter, ycenter, xtitle, ytitle, radius1, mid2pi360,mul
  862.       REAL startangle, endangle, midangle, startcenter, percent, xplode
  863.       CHARACTER * 80 tempstr,numstr, percentstr, titles(0:maxgroup)
  864.       INTEGER  gmx , gmy, numgroup, pietype, cwin, j
  865.       LOGICAL pieval, per
  866.       RECORD /GroupInfoRec/ gcolors(0:maxgroup)
  867.       RECORD /explodeRec/ explode(0:maxgroup)
  868.       RECORD /grstype/ grstat(1:10)
  869.       COMMON /GrAttr/ grstat, cwin
  870.  
  871.  
  872.       sum = 0.0
  873.       startangle = 0.0
  874.       endangle = 0.0
  875.       percent = 0.0
  876.       Twopi360 = (2.0 * pi) / 360.0
  877.       CALL GetMaxCoords(gmx, gmy)
  878.       AspectR = (gmy * 1.3) /REAL( gmx)
  879.       CALL SetTextJustifyXX(0, 1)
  880.       IF (pietype .EQ. 0) THEN
  881.         startcenter = 2.0
  882.       ELSE
  883.         startcenter = 3.0
  884.       END IF
  885.       xw = ABS(grstat(cwin).plotrect.right -
  886.      +         grstat(cwin).plotrect.left)
  887.       yw = ABS(grstat(cwin).plotrect.bottom -
  888.      +          grstat(cwin).plotrect.top)
  889.       xc = (grstat(cwin).plotrect.left -
  890.      +      grstat(cwin).drawingrect.left) + xw/ startcenter
  891.       yc = (grstat(cwin).drawingrect.bottom -
  892.      +      grstat(cwin).plotrect.bottom) + yw/ 2.0
  893.       IF (xc .GT. yc) THEN
  894.         radius = 0.17 * xw
  895.       ELSE
  896.         radius = 0.17 * yw
  897.       END IF
  898.       DO i = 0, numgroup - 1
  899.         sum = sum + xdata(i)
  900.       END DO
  901.       DO i = 0, numgroup - 1
  902.         xcenter = xc
  903.         ycenter = yc
  904.         DO j = 1, 80
  905.           numstr(j:j) = '  '
  906.           percentstr(j:j) = ' '
  907.           tempstr(j:j) = ' '
  908.         END DO
  909.         CALL SelectColor(gcolors(i).GroupColor)
  910.         CALL SetFillStyleXX(gcolors(i).GroupHatch,
  911.      +                      gcolors(i).GroupColor)
  912.         startangle = endangle + 1.0
  913.         IF (i .EQ. 0)   startangle = 0.0
  914.         endangle = (endangle + ((xdata(i) / sum) * 360.0))
  915.         midangle = (startangle + endangle) / 2.0
  916.         percent = (xdata(i) / sum) * 100.0
  917.  
  918.         IF (per) THEN
  919.            CALL RealToString( percent, 2, 1, percentstr)
  920.         END IF
  921.         IF (PieVal) THEN
  922.            CALL ConvertNum(xdata(i), 0, sum,
  923.      +                     sum / 180.0, .FALSE., numstr)
  924.            IF (per)  CALL Combine( numstr, '%')
  925.         END IF
  926.         tempstr = numstr
  927.         CALL Combine(tempstr,percentstr)
  928.         percentstr = tempstr
  929.  
  930.         IF (startangle .GT. 359.0)  startangle = 359.0
  931.         IF (endangle .GT. 360.0)    endangle = 360.0
  932.         mid2pi360 = Twopi360 * midangle
  933.         IF (explode(i).explodetrue) THEN
  934.           xplode = explode(i).percent * radius
  935.           xcenter = xc + (xplode * COS(mid2pi360))
  936.           ycenter = yc + (xplode * AspectR * SIN(mid2pi360))
  937.         END IF
  938.         CALL PieXX(xcenter, ycenter, startangle, endangle,
  939.      +             radius, AspectR)
  940.         radius1 = radius * 1.3
  941.         xtitle = xcenter + (radius1 * COS(mid2pi360))
  942.         ytitle = ycenter + (AspectR * radius1 * SIN(mid2pi360))
  943.         IF (midangle .GT. 90.0 .AND. midangle .LE. 270.0) THEN
  944.           CALL SetTextJustifyXX(2, 1)
  945.         ELSE
  946.           CALL SetTextJustifyXX(0, 1)
  947.         END IF
  948.         IF (pietype .EQ. 0) THEN
  949.           IF (midangle .GT. 30 .AND. midangle .LT. 150) THEN
  950.              mul = 1
  951.           ELSE
  952.              mul = 0
  953.           END IF
  954.           ytitle = ytitle + 9 * mul
  955.           CALL OutTextPie(xtitle, ytitle, titles(i))
  956.           CALL OutTextPie(xtitle, ytitle - 8, percentstr)
  957.         ELSE
  958.           CALL OutTextPie(xtitle, ytitle, percentstr)
  959.         END IF
  960.         CALL SetTextJustifyXX(0, centertext)
  961.  
  962.       END DO
  963.       IF (pietype .EQ. 1) CALL PieLegend(titles, numgroup, gcolors)
  964.  
  965.       END !SUBROUTINE
  966.  
  967.  
  968.       SUBROUTINE PieLegend (titles, numgroup, gcolors)
  969.       INCLUDE 'GRAFTYPE.FOR'
  970.       CHARACTER * 80 titles(0:20)
  971.       INTEGER  numgroup, i
  972.       REAL textstart, boxsize, boxstart
  973.       RECORD /GroupInfoRec/ gcolors(0:maxgroup)
  974.       RECORD /WorldRect/ d
  975.       REAL ypos
  976.  
  977.       textstart = 800.0
  978.       boxsize = 40.0
  979.       boxstart = 725.0
  980.  
  981.       CALL SetWorldRect(d, 0.0, 0.0, 1000.0, 1000.0)
  982.       CALL SetWorldCoordinates(d)
  983.       CALL SetTextJustifyXX(lefttext, 0)
  984.       CALL SelectColor(15)
  985.       CALL moveworldabs(700.0, 200.0)
  986.       CALL lineworldabs(700.0, 800.0)
  987.       CALL lineworldabs(999.0, 800.0)
  988.       CALL lineworldabs(999.0, 200.0)
  989.       CALL lineworldabs(700.0, 200.0)
  990.       ypos = 725
  991.       DO i = 0, numgroup - 1
  992.         CALL SelectColor(15)
  993.         CALL moveworldabs(textstart, ypos)
  994.         CALL OutTextXX(titles(i))
  995.         CALL SetFillStyleXX(gcolors(i).GroupHatch,
  996.      +                      gcolors(i).GroupColor)
  997.         CALL BarWorld(boxstart, ypos, boxsize, boxsize,
  998.      +         gcolors(i).GroupColor, gcolors(i).GroupHatch)
  999.         ypos = ypos - (500.0 /REAL( numgroup))
  1000.       END DO
  1001.       CALL SetTextJustifyXX(lefttext, 0)
  1002.  
  1003.       END !SUBROUTINE
  1004.  
  1005.       SUBROUTINE PlotErrorBars (datasetx, datasety1, datasety2,
  1006.      +                          numdat, barwid, newcolor)
  1007.       INCLUDE 'GRAFTYPE.FOR'
  1008.       INCLUDE 'STDHDR.FOR'
  1009.       INTEGER cwin, numdat, newcolor, i, OldColor, iErr
  1010.       REAL datasetx(0:maxv), datasety1(0:maxv), datasety2(0:maxv)
  1011.  
  1012.       REAL barwid, xx1, yy1, xx2, yy2
  1013.       RECORD /grstype/ grstat(1:10)
  1014.       COMMON /GrAttr/ grstat, cwin
  1015.       REAL tx[ALLOCATABLE](:),ty1[ALLOCATABLE](:),ty2[ALLOCATABLE](:)
  1016.  
  1017.       ALLOCATE(tx(0:maxV),ty1(0:maxV),ty2(0:maxV),STAT=iErr)
  1018.       CALL CheckMem(iErr)
  1019.       CALL GetColXX(OldColor)
  1020.       CALL SelectColor(newcolor)
  1021.  
  1022.       CALL CopyVectors(datasetx, tx, numdat)
  1023.       CALL CopyVectors(datasety1, ty1, numdat)
  1024.       CALL CopyVectors(datasety2, ty2, numdat)
  1025.       CALL PrePlot(tx, ty1, numdat)
  1026.  
  1027.       IF (grstat(cwin).LogY) THEN
  1028.         DO i = 0, numdat - 1
  1029.            ty2(i) = log10(ty2(i))
  1030.         END DO
  1031.       END IF
  1032.       IF (grstat(cwin).LogX)
  1033.      +    barwid = (log10(grstat(cwin).plotclip.right) -
  1034.      +              log10(grstat(cwin).plotclip.left)) / (numdat*1.1)
  1035.       DO i = 0, numdat - 1
  1036.         yy1 = ty1(i)
  1037.         yy2 = ty2(i)
  1038.         xx1 = tx(i) - barwid / 2.0
  1039.         xx2 = xx1 + barwid
  1040.         CALL moveworldabs(xx1, yy1)
  1041.         CALL lineworldabs(xx2, yy1)
  1042.         CALL moveworldabs(xx1, yy2)
  1043.         CALL lineworldabs(xx2, yy2)
  1044.       END DO
  1045.       CALL PostPlot
  1046.       CALL SelectColor(OldColor)
  1047.       DEALLOCATE(tx,ty1,ty2,STAT=iErr)
  1048.       CALL CheckDealloc(iErr)
  1049.       END !SUBROUTINE
  1050.  
  1051.  
  1052.  
  1053.  
  1054.       SUBROUTINE PostPlot
  1055.       INCLUDE 'GRAFTYPE.FOR'
  1056.       INTEGER cwin
  1057.       RECORD /grstype/ grstat(1:10)
  1058.       RECORD /WorldRect/ Worlda, Worldb
  1059.       COMMON /GrAttr/ grstat, cwin
  1060.       COMMON /GlobalWR/ Worlda, Worldb
  1061.  
  1062.       grstat(cwin).plotworld = Worlda
  1063.       grstat(cwin).plotclip = Worldb
  1064.       CALL SetGraphViewport(grstat(cwin).drawingRect.left,
  1065.      +  grstat(cwin).drawingRect.top, grstat(cwin).drawingRect.right,
  1066.      +  grstat(cwin).drawingRect.bottom)
  1067.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  1068.       END !SUBROUTINE
  1069.  
  1070.  
  1071.  
  1072.  
  1073.  
  1074.  
  1075.       SUBROUTINE PrePlot (datasetx, datasety, numdat)
  1076.       INCLUDE 'GRAFTYPE.FOR'
  1077.       INCLUDE 'STDHDR.FOR'
  1078.       REAL datasetx(0:maxv), datasety(0:maxv), xx1, yy1, xx2, yy2
  1079.       INTEGER cwin, numdat,i
  1080.       RECORD /grstype/ grstat(1:10)
  1081.       RECORD /WorldRect/ Wr, Worlda, Worldb
  1082.       COMMON /GrAttr/ grstat, cwin
  1083.       COMMON /GlobalWR/ Worlda, Worldb
  1084.  
  1085.       Worlda = grstat(cwin).plotworld
  1086.       Worldb = grstat(cwin).plotclip
  1087.       IF (grstat(cwin).LogX) THEN
  1088.         xx1 = log10(grstat(cwin).plotclip.left)
  1089.         xx2 = log10(grstat(cwin).plotclip.right)
  1090.         DO i = 0, numdat - 1
  1091.           datasetx(i) = log10(ABS(datasetx(i)))
  1092.         END DO
  1093.       ELSE
  1094.         xx1 = grstat(cwin).plotclip.left
  1095.         xx2 = grstat(cwin).plotclip.right
  1096.       END IF
  1097.       IF (grstat(cwin).LogY) THEN
  1098.         yy1 = log10(grstat(cwin).plotclip.bottom)
  1099.         yy2 = log10(grstat(cwin).plotclip.top)
  1100.         DO i = 0, numdat - 1
  1101.           datasety(i) = log10(ABS(datasety(i)))
  1102.         END DO
  1103.       ELSE
  1104.         yy1 = grstat(cwin).plotclip.bottom
  1105.         yy2 = grstat(cwin).plotclip.top
  1106.       END IF
  1107.       CALL SetWorldRect(wr, xx1, yy1, xx2, yy2)
  1108.       CALL SetGraphViewport(grstat(cwin).plotrect.left,
  1109.      +   grstat(cwin).plotrect.top, grstat(cwin).plotrect.right,
  1110.      +   grstat(cwin).plotrect.bottom)
  1111.       CALL SetWorldCoordinates(wr)
  1112.       END !SUBROUTINE
  1113.  
  1114.       SUBROUTINE RealLegends (rv, colorMap, n, barLine)
  1115.       INCLUDE 'GRAFTYPE.FOR'
  1116.       REAL rv(0:MaxLegends)
  1117.       RECORD /GroupInfoRec/ ColorMap(0:MaxLegends)
  1118.       INTEGER  i, n, barline
  1119.       CHARACTER * 80 sv(0:20)
  1120.  
  1121.       DO i = 0, n - 1
  1122.            CALL RealToString(rv(i), 1, 1, sv(i))
  1123.       END DO
  1124.       CALL StringLegends(sv, colorMap, n, barLine)
  1125.       END !SUBROUTINE
  1126.  
  1127.  
  1128.       SUBROUTINE RoundAxes (a1, a2, tics)
  1129.       INCLUDE 'GRAFTYPE.FOR'
  1130.       INTEGER cwin
  1131.       RECORD /grstype/ grstat(1:10)
  1132.       COMMON /GrAttr/ grstat, cwin
  1133.       REAL a1, a2, tics, dr1, dr2, px2, pc2
  1134.       INTEGER di1, di2, digits, a1neg, a2neg
  1135.  
  1136.  
  1137.       IF (a1 .LT. 0 ) THEN
  1138.         a1neg = 1
  1139.       ELSE
  1140.         a1neg = 0
  1141.       END IF
  1142.       IF (a2 .GT. 0) THEN
  1143.         a2neg = 1
  1144.       ELSE
  1145.         a2neg = 0
  1146.       END IF
  1147.  
  1148.       IF (NumExp(a2) .GT. NumExp(a1)) THEN
  1149.         px2 = REAL(NumExp(a2)) - 1.0
  1150.       ELSE
  1151.         px2 = REAL(NumExp(a1)) - 1.0
  1152.       END IF
  1153.       pc2 = PowerCalc(10.0, px2)
  1154.       dr2 = a2 / pc2
  1155.       dr1 = a1 / pc2
  1156.  
  1157.       di2 = AINT(dr2 + (dr2 - dr1) * .05)
  1158.       IF (di2 .GT. 0 .AND.  dr2 .LE. 0.0)  di2 = 0
  1159.  
  1160.       di1 = AINT(dr1 - (dr2 - dr1) * .05)
  1161.       IF (di1 .LT. 0  .AND. dr1 .GE. 0.0)  di1 = 0
  1162.  
  1163.       IF (ABS(di2) .LT. 5) THEN
  1164.         di2 = di2 + a2neg
  1165.       ELSEIF (ABS(di2) .LT. 60) THEN
  1166.         di2 = ((di2 / 5) + a2neg) * 5
  1167.       ELSE
  1168.         di2 = ((di2 / 10) + a2neg) * 10
  1169.       END IF
  1170.       IF (ABS(di1) .LT. 5) THEN
  1171.         di1 = di1 - a1neg
  1172.       ELSEIF (ABS(di1) .LT. 60) THEN
  1173.         di1 = ((di1 / 5) - a1neg) * 5
  1174.       ELSE
  1175.         di1 = ((di1 / 10) - a1neg) * 10
  1176.       END IF
  1177.       a1 = REAL(di1) * pc2
  1178.       a2 = REAL(di2) * pc2
  1179.       digits = ABS(di2 - di1)
  1180.       IF (digits .LT. 10) THEN
  1181.         tics = 1.0
  1182.       ELSEIF (digits .LT. 20)  THEN
  1183.         tics = 2.0
  1184.       ELSEIF (digits .LT. 50)  THEN
  1185.         tics = 5.0
  1186.       ELSEIF (digits .LT. 80)  THEN
  1187.         tics = 10.0
  1188.       ELSEIF (digits .LT. 100) THEN
  1189.         tics = 20.0
  1190.       ELSEIF (digits .LT. 151) THEN
  1191.         tics = 20.0
  1192.       ELSEIF (digits .LT. 200) THEN
  1193.         tics = 50.0
  1194.       ELSE
  1195.         tics = 100.0
  1196.       END IF
  1197.       tics = tics * (pc2) / 10.0
  1198.       END !SUBROUTINE
  1199.  
  1200.       SUBROUTINE ScaleLinX (xx1, xx2)
  1201.       INCLUDE 'GRAFTYPE.FOR'
  1202.       INTEGER cwin
  1203.       REAL xx1, xx2
  1204.       RECORD /grstype/ grstat(1:10)
  1205.       COMMON /GrAttr/ grstat, cwin
  1206.  
  1207.       CALL SetGraphAreaWorld(xx1, grstat(cwin).plotclip.bottom,
  1208.      +                       xx2, grstat(cwin).plotclip.top)
  1209.       grstat(cwin).LogX = .FALSE.
  1210.       END !SUBROUTINE
  1211.  
  1212.  
  1213.       SUBROUTINE ScalePlotArea (xx1, yy1, xx2, yy2)
  1214.       INCLUDE 'GRAFTYPE.FOR'
  1215.       INTEGER cwin
  1216.       REAL xx1, yy1, xx2, yy2
  1217.       RECORD /grstype/ grstat(1:10)
  1218.       COMMON /GrAttr/ grstat, cwin
  1219.  
  1220.        IF (grstat(cwin).LogX) THEN
  1221.          CALL ScaleLogX(xx1, xx2)
  1222.        ELSE
  1223.          CALL ScaleLinX(xx1, xx2)
  1224.        END IF
  1225.        IF (grstat(cwin).LogY) THEN
  1226.          CALL ScaleLogY(yy1, yy2)
  1227.        ELSE
  1228.          CALL ScaleLinY(yy1, yy2)
  1229.        END IF
  1230.  
  1231.       END !SUBROUTINE
  1232.  
  1233.       SUBROUTINE ScatterPlotData (datasetx, datasety,
  1234.      +                           numdat, newcolor, markType)
  1235.       INCLUDE 'STDHDR.FOR'
  1236.       INCLUDE 'GRAFTYPE.FOR'
  1237.       INTEGER cwin, numdat,newcolor,markType, i, k, OldColor, iErr
  1238.       RECORD /grstype/ grstat(1:10)
  1239.       COMMON /GrAttr/ grstat, cwin
  1240.       REAL MarkerX(0: 2, 0: 6),MarkerY(0: 2, 0: 6)
  1241.       REAL datasetx(0:maxv), datasety(0:maxv)
  1242.       REAL pfsfx, pfsfy, pfx(0: 6), pfy(0: 6)
  1243.       REAL tx[ALLOCATABLE](:),ty[ALLOCATABLE](:)
  1244.  
  1245.       ALLOCATE(tx(0:maxV),ty(0:maxV),STAT=iErr)
  1246.       CALL CheckMem(iErr)
  1247.  
  1248.       MarkerX(0, 0) = -.5
  1249.       MarkerX(0, 1) = 0.0
  1250.       MarkerX(0, 2) = 1.0
  1251.       MarkerX(0, 3) = 0.0
  1252.       MarkerX(0, 4) = -1.0
  1253.       MarkerX(0, 5) = 0.0
  1254.       MarkerX(0, 6) = 0.0
  1255.  
  1256.       MarkerX(1, 0) = -.5
  1257.       MarkerX(1, 1) = .5
  1258.       MarkerX(1, 2) = .5
  1259.       MarkerX(1, 3) = -1.0
  1260.       MarkerX(1, 4) = 0.0
  1261.       MarkerX(1, 5) = 0.0
  1262.       MarkerX(1, 6) = 0.0
  1263.  
  1264.       MarkerX(2, 0) = 0.0
  1265.       MarkerX(2, 1) = -.5
  1266.       MarkerX(2, 2) = .5
  1267.       MarkerX(2, 3) = .5
  1268.       MarkerX(2, 4) = -.5
  1269.       MarkerX(2, 5) = 0.0
  1270.       MarkerX(2, 6) = 0.0
  1271.  
  1272.       MarkerY(0, 0) = -.5
  1273.       MarkerY(0, 1) = 1.0
  1274.       MarkerY(0, 2) = 0.0
  1275.       MarkerY(0, 3) = -1.0
  1276.       MarkerY(0, 4) = 0.0
  1277.       MarkerY(0, 5) = 0.0
  1278.       MarkerY(0, 6) = 0.0
  1279.  
  1280.       MarkerY(1, 0) = -.5
  1281.       MarkerY(1, 1) = 1.0
  1282.       MarkerY(1, 2) = -1.0
  1283.       MarkerY(1, 3) = 0.0
  1284.       MarkerY(1, 4) = 0.0
  1285.       MarkerY(1, 5) = 0.0
  1286.       MarkerY(1, 6) = 0.0
  1287.  
  1288.       MarkerY(2, 0) = -.5
  1289.       MarkerY(2, 1) = .5
  1290.       MarkerY(2, 2) = .5
  1291.       MarkerY(2, 3) = -.5
  1292.       MarkerY(2, 4) = -.5
  1293.       MarkerY(2, 5) = 0.0
  1294.       MarkerY(2, 6) = 0.0
  1295.  
  1296.  
  1297.       CALL GetColXX(OldColor)
  1298.       CALL SelectColor(newcolor)
  1299.       CALL CopyVectors(datasetx, tx, numdat)
  1300.       CALL CopyVectors(datasety, ty, numdat)
  1301.  
  1302.       IF (markType .GT. 2) THEN markType = 0
  1303.       CALL PrePlot(tx, ty, numdat)
  1304.       IF (grstat(cwin).LogX) THEN
  1305.         pfsfx = (log10(grstat(cwin).plotclip.right) -
  1306.      +           log10(grstat(cwin).plotclip.left)) * .02
  1307.       ELSE
  1308.         pfsfx = (grstat(cwin).plotclip.right -
  1309.      +           grstat(cwin).plotclip.left) * .02
  1310.       END IF
  1311.       IF (grstat(cwin).LogY) THEN
  1312.         pfsfy = (log10(grstat(cwin).plotclip.top) -
  1313.      +           log10(grstat(cwin).plotclip.bottom)) * .02
  1314.       ELSE
  1315.         pfsfy = (grstat(cwin).plotclip.top -
  1316.      +           grstat(cwin).plotclip.bottom) * .02
  1317.       END IF
  1318.  
  1319.       DO i = 0, 6
  1320.         pfx(i) = MarkerX(markType, i) * pfsfx
  1321.         pfy(i) = MarkerY(markType, i) * pfsfy
  1322.       END DO
  1323.       k = 5
  1324.       DO i = 0, numdat - 1
  1325.         CALL moveworldabs(tx(i), ty(i))
  1326.         CALL polyLineWorldRel(pfx, pfy, k)
  1327.       END DO
  1328.       CALL PostPlot
  1329.       CALL SelectColor(OldColor)
  1330.       DEALLOCATE(tx,ty,STAT=iErr)
  1331.       CALL CheckDealloc(iErr)
  1332.       END !SUBROUTINE
  1333.  
  1334.       SUBROUTINE SetAxesType (PlotTypeX, PlotTypeY)
  1335.       INCLUDE 'GRAFTYPE.FOR'
  1336.       INTEGER cwin, PlotTypeX, PlotTypeY
  1337.       RECORD /grstype/ grstat(1:10)
  1338.       COMMON /GrAttr/ grstat, cwin
  1339.  
  1340.       IF (PlotTypeX .EQ. 1) THEN
  1341.         grstat(cwin).LogX = .TRUE.
  1342.       ELSE
  1343.         grstat(cwin).LogX = .FALSE.
  1344.       END IF
  1345.       IF (PlotTypeY .EQ. 1) THEN
  1346.         grstat(cwin).LogY = .TRUE.
  1347.       ELSE
  1348.         grstat(cwin).LogY = .FALSE.
  1349.       END IF
  1350.       END !SUBROUTINE
  1351.  
  1352.       SUBROUTINE SetCurrentWindow (win)
  1353.       INCLUDE 'GRAFTYPE.FOR'
  1354.       INTEGER cwin, win
  1355.       RECORD /grstype/ grstat(1:10)
  1356.       COMMON /GrAttr/ grstat, cwin
  1357.       cwin = win
  1358.       CALL SetGraphWindow
  1359.       END !SUBROUTINE
  1360.  
  1361.  
  1362.       SUBROUTINE SetGraphWindow
  1363.       INCLUDE 'GRAFTYPE.FOR'
  1364.       INTEGER cwin
  1365.       RECORD /grstype/ grstat(1:10)
  1366.       COMMON /GrAttr/ grstat, cwin
  1367.  
  1368.       CALL SetGraphViewport(grstat(cwin).drawingRect.left,
  1369.      +  grstat(cwin).drawingRect.top, grstat(cwin).drawingRect.right,
  1370.      +  grstat(cwin).drawingRect.bottom)
  1371.       END !SUBROUTINE
  1372.  
  1373.       SUBROUTINE SetPercentWindow (x1, y1, x2, y2, win)
  1374.       INCLUDE 'GRAFTYPE.FOR'
  1375.       INTEGER cwin, win, maxX, maxY
  1376.       REAL x1, y1, x2, y2
  1377.       RECORD /grstype/ grstat(1:10)
  1378.       COMMON /GrAttr/ grstat, cwin
  1379.  
  1380.       CALL GetMaxCoords(maxX, maxY)
  1381.       CALL DefGraphWindow(NINT(x1 * maxX), NINT(y1 * maxY),
  1382.      +                    NINT(x2 * maxX), NINT(y2 * maxY), win)
  1383.       END !SUBROUTINE
  1384.  
  1385.       SUBROUTINE SetPlotBackground (c)
  1386.       INCLUDE 'GRAFTYPE.FOR'
  1387.       INTEGER cwin, c
  1388.       RECORD /grstype/ grstat(1:10)
  1389.       COMMON /GrAttr/ grstat, cwin
  1390.  
  1391.       CALL SetFillStyleXX(1, c)
  1392.       CALL SetGraphViewport(grstat(cwin).plotrect.left,
  1393.      +  grstat(cwin).plotrect.top, grstat(cwin).plotrect.right,
  1394.      +  grstat(cwin).plotrect.bottom)
  1395.       CALL BarXX(0.0, 0.0, REAL(grstat(cwin).plotrect.right -
  1396.      +   grstat(cwin).plotrect.left),
  1397.      +    REAL( grstat(cwin).plotrect.bottom -
  1398.      +   grstat(cwin).plotrect.top))
  1399.       CALL SetGraphViewport(grstat(cwin).drawingRect.left,
  1400.      + grstat(cwin).drawingRect.top, grstat(cwin).drawingRect.right,
  1401.      + grstat(cwin).drawingRect.bottom)
  1402.       END !SUBROUTINE
  1403.  
  1404.       SUBROUTINE SetRect (Worldr, xx1, yy1, xx2, yy2)
  1405.       INCLUDE 'GRAFTYPE.FOR'
  1406.       RECORD /Rect/ Worldr
  1407.       INTEGER xx1, yy1, xx2, yy2
  1408.  
  1409.       WorldR.left = xx1
  1410.       WorldR.top = yy1
  1411.       WorldR.right = xx2
  1412.       WorldR.bottom = yy2
  1413.       END !SUBROUTINE
  1414.  
  1415.       SUBROUTINE SetViewBackground (c)
  1416.       INCLUDE 'GRAFTYPE.FOR'
  1417.       INTEGER cwin,c
  1418.       RECORD /grstype/ grstat(1:10)
  1419.       COMMON /GrAttr/ grstat, cwin
  1420.  
  1421.       CALL SetGlobalView(c)
  1422.       CALL SetFillStyleXX(2, c)
  1423.       CALL BarXX(0.0, 0.0,REAL(grstat(cwin).drawingRect.right -
  1424.      + grstat(cwin).drawingRect.left),
  1425.      + REAL(grstat(cwin).drawingRect.bottom-
  1426.      + grstat(cwin).drawingRect.top))
  1427.       END !SUBROUTINE
  1428.  
  1429.       SUBROUTINE SetWin2PlotRatio (win, l, t, r, b)
  1430.       INCLUDE 'GRAFTYPE.FOR'
  1431.       INTEGER win, cwin
  1432.       REAL l,t,r,b
  1433.       RECORD /grstype/ grstat(1:10)
  1434.       COMMON /GrAttr/ grstat, cwin
  1435.  
  1436.       grstat(win).win2plotratio.left = l
  1437.       grstat(win).win2plotratio.right = r
  1438.       grstat(win).win2plotratio.top = t
  1439.       grstat(win).win2plotratio.bottom = b
  1440.       grstat(win).plotrect.left = grstat(win).drawingRect.left+
  1441.      + NINT((grstat(win).drawingRect.right -
  1442.      + grstat(win).drawingRect.left) *grstat(win).win2plotratio.left)
  1443.       grstat(win).plotrect.bottom = grstat(win).drawingRect.bottom -
  1444.      +  NINT((grstat(win).drawingRect.bottom -
  1445.      +  grstat(win).drawingRect.top) *grstat(win).win2plotratio.bottom)
  1446.       grstat(win).plotrect.right = grstat(win).drawingRect.right -
  1447.      +  NINT((grstat(win).drawingRect.right -
  1448.      +  grstat(win).drawingRect.left) *grstat(win).win2plotratio.right)
  1449.       grstat(win).plotrect.top = grstat(win).drawingRect.top +
  1450.      +  NINT((grstat(win).drawingRect.bottom -
  1451.      +  grstat(win).drawingRect.top) *grstat(win).win2plotratio.top)
  1452.       END !SUBROUTINE
  1453.  
  1454.       SUBROUTINE SetXYIntercepts (xx1, yy1)
  1455.       INCLUDE 'GRAFTYPE.FOR'
  1456.       INTEGER cwin
  1457.       REAL xx1, yy1
  1458.       RECORD /grstype/ grstat(1:10)
  1459.       COMMON /GrAttr/ grstat, cwin
  1460.  
  1461.       grstat(cwin).xint = xx1
  1462.       grstat(cwin).yint = yy1
  1463.       END !SUBROUTINE
  1464.  
  1465.       SUBROUTINE SortData (x, y, n, d)
  1466.       INCLUDE 'STDHDR.FOR'
  1467.       INTEGER j, k, n, d, iErr
  1468.       LOGICAL abort
  1469.       REAL TempX, TempY, x(0:maxv), y(0:maxv)
  1470.       REAL TempArray[ALLOCATABLE](:)
  1471.  
  1472.       ALLOCATE(TempArray(0:maxV),STAT=iErr)
  1473.       CALL CheckMem(iErr)
  1474.  
  1475.       IF (n .GT. 1) THEN
  1476.         DO j = 0, n - 1
  1477.           abort = .FALSE.
  1478.           TempX = x(j)
  1479.           TempY = y(j)
  1480.           k = j - 1
  1481.           DO WHILE ((.NOT. abort) .AND. (k .GE. 0))
  1482.             IF (TempX .LT. x(k)) THEN
  1483.               x(k + 1) = x(k)
  1484.               y(k + 1) = y(k)
  1485.               k = k - 1
  1486.             ELSE
  1487.               abort = .TRUE.
  1488.             END IF
  1489.           END DO
  1490.           x(k + 1) = TempX
  1491.           y(k + 1) = TempY
  1492.         END DO
  1493.  
  1494.         IF (d .EQ. 0) THEN
  1495.           DO j = 0, n - 1
  1496.             TempArray(j) = x(j)
  1497.           END DO
  1498.           DO j = n - 1, 0 , -1
  1499.             x(j) = TempArray(n - 1 - j)
  1500.           END DO
  1501.           DO j = 0, n - 1
  1502.             TempArray(j) = y(j)
  1503.           END DO
  1504.           DO j = n - 1, 0 , -1
  1505.             y(j) = TempArray(n - 1 - j)
  1506.           END DO
  1507.         END IF
  1508.       END IF
  1509.       DEALLOCATE(TempArray,STAT=iErr)
  1510.       CALL CheckDealloc(iErr)
  1511.       END !SUBROUTINE
  1512.  
  1513.       SUBROUTINE SortDataX (x, y, n, d)
  1514.       INCLUDE 'STDHDR.FOR'
  1515.       INTEGER  n, d
  1516.       REAL x(0:maxv), y(0:maxv)
  1517.  
  1518.       CALL SortData(x, y, n, d)
  1519.       END !SUBROUTINE
  1520.  
  1521.       SUBROUTINE SortDataY (x, y, n, d)
  1522.       INCLUDE 'STDHDR.FOR'
  1523.       INTEGER  n, d
  1524.       REAL x(0:maxv), y(0:maxv)
  1525.  
  1526.       CALL SortData(y, x, n, d)
  1527.       END !SUBROUTINE
  1528.  
  1529.  
  1530.  
  1531.       SUBROUTINE StringLegends (sv, colorMap, n, barLine)
  1532.       INCLUDE 'GRAFTYPE.FOR'
  1533.       INTEGER cwin, i,n, barline
  1534.       CHARACTER * 80 sv(0:MaxLegends)
  1535.       RECORD /GroupInfoRec/ colorMap(0:MaxLegends)
  1536.       RECORD /grstype/ grstat(1:10)
  1537.       COMMON /GrAttr/ grstat, cwin
  1538.       RECORD /WorldRect/ StrRect
  1539.       REAL charSizeX, charSizeY, xpos, ypos
  1540.  
  1541.       CALL SetTextJustifyXX(0, 1)
  1542.       charSizeX = 1000.0 /REAL((grstat(cwin).drawingRect.right -
  1543.      +    grstat(cwin).drawingRect.left) / 8)
  1544.       charSizeY = 1000.0 /REAL(ABS(grstat(cwin).drawingRect.top -
  1545.      +     grstat(cwin).drawingRect.bottom) / 8)
  1546.       CALL SetWorldRect(StrRect, 0.0, 0.0, 1000.0, 1000.0)
  1547.       CALL SetWorldCoordinates(StrRect)
  1548.       xpos = charSizeX + 10.0
  1549.       ypos = 950.0 - charSizeY
  1550.       DO i = 0, n - 1
  1551.         CALL SelectColor(colorMap(i).GroupColor)
  1552.         IF (barLine .EQ. 0) THEN
  1553.           CALL moveworldabs(xpos, ypos)
  1554.           CALL SetLineStyleXX(colorMap(i).GroupHatch,  1)
  1555.           CALL lineworldRel(2.0 * charSizeX, 0.0)
  1556.         ELSE
  1557.           CALL SetFillStyleXX(colorMap(i).GroupHatch,
  1558.      +                        colorMap(i).GroupColor)
  1559.           CALL BarWorld(xpos, ypos - 0.75 * charSizeY, 1.5*charSizeY,
  1560.      +      2.0 * charSizeX, colorMap(i).GroupColor,
  1561.      +      colorMap(i).GroupHatch)
  1562.         END IF
  1563.         CALL moveworldabs(xpos + 3.0 * charSizeX, ypos)
  1564.         CALL OutTextXX(sv(i))
  1565.         xpos = xpos + 5.0 * charSizeX + LEN_TRIM(sv(i)) * charSizeX
  1566.         IF (i .LT. n - 1  .AND. xpos + 5.0 * charSizeX +
  1567.      +       LEN_TRIM(sv(i + 1)) * charSizeX .GT. 980.0) THEN
  1568.           xpos = charSizeX + 10.0
  1569.           ypos = ypos - 2.0 * charSizeY
  1570.         END IF
  1571.       END DO
  1572.       CALL SetWorldCoordinates(grstat(cwin).plotworld)
  1573.       CALL SetTextJustifyXX(0, 0)
  1574.       CALL SetLineStyleXX(0,1)
  1575.       END !SUBROUTINE
  1576.  
  1577.  
  1578.  
  1579.  
  1580.       SUBROUTINE TitleWindow (GTitle)
  1581.       CHARACTER* (*) GTitle
  1582.       REAL x, y
  1583.       INTEGER font, dir, Hsize, VSize
  1584.  
  1585.       CALL GetTextStyleXX(font, dir, Hsize, VSize)
  1586.       CALL SetTextStyleXX(font, 0, Hsize,Vsize)
  1587.       x = 500.0
  1588.       y = 980.0
  1589.       CALL LabelGraphWindow(x, y, GTitle, 1, 2)
  1590.       CALL SetTextStyleXX(font, dir, Hsize, VSize)
  1591.       END !SUBROUTINE
  1592.  
  1593.  
  1594.  
  1595.  
  1596.  
  1597.       SUBROUTINE TitleXAxis (xtitle)
  1598.       CHARACTER* (*) xtitle
  1599.       REAL x, y
  1600.       INTEGER font, dir, Hsize, VSize
  1601.  
  1602.       CALL GetTextStyleXX(font, dir, Hsize, VSize)
  1603.       CALL SetTextStyleXX(font, 0, Hsize, VSize)
  1604.       x = 500.0
  1605.       y = 15.0
  1606.       CALL LabelGraphWindow(x, y, xtitle, 1, 0)
  1607.       CALL SetTextStyleXX(font, dir, Hsize, VSize)
  1608.       END !SUBROUTINE
  1609.  
  1610.  
  1611.  
  1612.  
  1613.  
  1614.       SUBROUTINE TitleYAxis (ytitle)
  1615.       CHARACTER* (*) ytitle
  1616.       REAL x, y
  1617.       INTEGER font, dir, Hsize, VSize
  1618.  
  1619.       CALL GetTextStyleXX(font, dir, Hsize, VSize)
  1620.       CALL SetTextStyleXX(font, 1, Hsize, VSize)
  1621.       x = 35.0
  1622.       y = 500.0
  1623.       CALL LabelGraphWindow(x, y, ytitle, 0, 1)
  1624.       CALL SetTextStyleXX(font, dir, Hsize, VSize)
  1625.       END !SUBROUTINE
  1626.  
  1627. !
  1628. ! 1/19/90  Edited GroupplotData to reflect maxgroup, maxv changes
  1629. !          updated Copy1&2 vectors for these changes
  1630. !