home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l292 / 1.ddi / CONTOUR.FOR < prev    next >
Encoding:
Text File  |  1990-02-19  |  1.9 KB  |  74 lines
  1.  
  2.       INCLUDE 'GRAFTYPE.FOR'
  3.       INTEGER i
  4.  
  5.       REAL ContourMap(0:maxContourX,0:maxContourY)
  6.       RECORD /GroupInfoRec/ ContourColors(0:maxLegends)
  7.       COMMON /CM/ ContourMap
  8.  
  9.       DO i = 0, 60
  10.         contourColors(i).groupcolor = mod(i, 15)+1
  11.         contourColors(i).grouphatch = 0
  12.       END DO
  13.       CALL createFunction
  14.       CALL InitSEGraphics(-1, 'C:\FOR\LIB\*.FON')
  15.  
  16.       CALL SetPercentWindow( 0.05,0.05, 0.95,0.80,4)
  17.       CALL SetPercentWindow( 0.05,0.83,0.95,0.95,3)
  18.  
  19.       CALL SetCurrentWindow(4)
  20.       CALL SetWin2PlotRatio(4, 0.15, 0.15, 0.1, 0.15 )
  21.  
  22.       CALL SetAxesType(0,0)
  23.       CALL ScalePlotArea( -7.5, -7.5, 7.5, 7.5)
  24.       CALL SelectColor(15)
  25.       CALL SetXYIntercepts(-7.5,-7.5)
  26.       CALL DrawYAxis(0.5,0)
  27.       CALL LabelYAxis(5, 0)
  28.       CALL DrawXAxis(0.5,0)
  29.       CALL LabelXAxis(5,0)
  30.       CALL SetXYIntercepts(7.5,7.5)
  31.       CALL DrawYAxis(0.5,1)
  32.       CALL LabelYAxis(5,1)
  33.       CALL DrawXAxis(0.5,1)
  34.       CALL LabelXAxis(5,1)
  35.       CALL SetLineStyleXX(1,1)
  36.       CALL DrawGridX(5)
  37.       CALL DrawGridY(5)
  38.       CALL ContourPlot(contourMap,61,61,1.0,contourColors)
  39.       CALL BorderCurrentWindow(15)
  40.       CALL SetCurrentWindow(3)
  41.       CALL BorderCurrentWindow(15)
  42.       CALL ContourPlotLegends(contourMap, 61,61,1.0,ContourColors)
  43.       READ(*,*)
  44.       CALL CloseSEGraphics
  45.  
  46.       END
  47.  
  48.  
  49.  
  50.       FUNCTION Calc3DFunction(x,y)
  51.       REAL x, y
  52.          Calc3DFunction = 3.0 * sin(sqrt(x*x+y*y))
  53.       END
  54.  
  55.  
  56.       SUBROUTINE CreateFunction()
  57.       INCLUDE 'GRAFTYPE.FOR'
  58.       REAL ContourMap(0:maxContourX,0:maxContourY)
  59.       INTEGER i,j
  60.       REAL x,y,z
  61.       COMMON /CM/ ContourMap
  62.       DO i = 0, 60
  63.        x = REAL(i-30)/4.0
  64.        DO j = 0, 60
  65.          y = REAL(j-30)/4.0
  66.          z = Calc3DFunction(x,y)
  67.          contourMap(i,j) = z
  68.         END DO
  69.       END DO
  70.       END
  71.  
  72.  
  73.  
  74.