home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / maths / pgplot_1 / Examples / f77 / PGDEMO2 < prev    next >
Text File  |  1997-06-11  |  15KB  |  497 lines
  1.       PROGRAM PGDEM2
  2. C-----------------------------------------------------------------------
  3. C Demonstration program for PGPLOT. The main program opens the output
  4. C device and calls a series of subroutines, one for each sample plot.
  5. C-----------------------------------------------------------------------
  6.       INTEGER PGOPEN
  7. C
  8. C Call PGOPEN to initiate PGPLOT and open the output device; PGOPEN
  9. C will prompt the user to supply the device name and type.
  10. C
  11.       IF (PGOPEN('?') .LE. 0) STOP
  12. C
  13. C Call the demonstration subroutines.
  14. C
  15.       CALL PGEX21
  16.       CALL PGEX22
  17.       CALL PGEX23
  18.       CALL PGEX24
  19.       CALL PGEX25
  20.       CALL PGEX26
  21. C
  22. C Finally, call PGCLOS to terminate things properly.
  23. C
  24.       CALL PGCLOS
  25. C-----------------------------------------------------------------------
  26.       END
  27.  
  28.       SUBROUTINE PGEX21
  29. C-----------------------------------------------------------------------
  30. C Test subroutine for PGPLOT: screen alignment and color palette.
  31. C-----------------------------------------------------------------------
  32.       INTEGER I, L1, L2
  33.       REAL X1, X2, Y1, Y2
  34.       CHARACTER*80 GTYPE, GVER
  35. C
  36. C Get PGPLOT information.
  37. C
  38.       CALL PGQINF('VERSION', GVER, L1)
  39.       CALL PGQINF('TYPE', GTYPE, L2)
  40.       CALL PGBBUF
  41. C
  42. C Alignment test: clear the screen, and draw a box and grid using
  43. C three monochrome intensities (color indices 1, 14, and 15).  The
  44. C plot uses the largest available square viewport and and unit window.
  45. C
  46.       CALL PGPAGE
  47.       CALL PGSVP(0.0,1.0,0.0,1.0)
  48.       CALL PGWNAD(0.0,1.0,0.0,1.0)
  49.       CALL PGSCI(14)
  50.       CALL PGBOX('g',0.02,1,'g',0.02,1)
  51.       CALL PGSCI(15)
  52.       CALL PGBOX('g',0.1,5,'g',0.1,5)
  53.       CALL PGSCI(1)
  54.       CALL PGBOX('bc',0.1,5,'bc',0.1,5)
  55. C
  56. C Color palette test.
  57. C
  58.       DO 20 I=0,15
  59.           CALL PGSCI(I)
  60.           X1 = 0.31 + MOD(I,4)*0.1
  61.           Y1 = 0.61 - (I/4)*0.1
  62.           X2 = X1 + 0.08
  63.           Y2 = Y1 + 0.08
  64.           CALL PGRECT(X1, X2, Y1, Y2)
  65.    20 CONTINUE
  66. C
  67. C Write the device type on the plot.
  68. C
  69.       CALL PGSCI(0)
  70.       CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97)
  71.       CALL PGSCI(1)
  72.       CALL PGSFS(2)
  73.       CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97)
  74.       CALL PGPTXT(0.5, 0.91, 0.0, 0.5, 'PGPLOT '//GVER(1:L1))
  75.       CALL PGPTXT(0.5, 0.87, 0.0, 0.5, 'Device '//GTYPE(1:L2))
  76. C
  77.       CALL PGEBUF
  78. C-----------------------------------------------------------------------
  79.       END
  80.  
  81.       SUBROUTINE PGEX22
  82. C-----------------------------------------------------------------------
  83. C Demonstration program for the PGPLOT plotting package.
  84. C Plot a table of the standard PGPLOT graph marker symbols. This
  85. C program also illustrates how windows and viewports may be manipulated.
  86. C-----------------------------------------------------------------------
  87.       CHARACTER*2 LABEL
  88.       INTEGER NX, NY, N, IX, JY, LW
  89.       REAL X, X1, X2, XOFF, Y, Y1, Y2, YOFF, DX, DY
  90.       REAL XPIX1, XPIX2, YPIX1, YPIX2, RES
  91. C
  92. C Determine size of view surface.
  93. C Lower left corner is (X1,Y1), upper right (X2, Y2) [inches].
  94. C
  95.       CALL PGPAGE
  96.       CALL PGSVP(0.0, 1.0, 0.0, 1.0)
  97.       CALL PGQVP(1, X1, X2, Y1, Y2)
  98.       X = X2-X1
  99.       Y = Y2-Y1
  100. C
  101. C Determine device resolution (pixels/inch), and use it to choose
  102. C line width.
  103. C
  104.       CALL PGQVP(3, XPIX1, XPIX2, YPIX1, YPIX2)
  105.       RES = ABS(XPIX2-XPIX1)/ABS(X)
  106.       LW = 1
  107.       IF (RES.GT.166.0) LW = 2
  108. C
  109. C Choose horizontal or vertical arrangement depending on
  110. C device aspect ratio.
  111. C
  112.       IF (X.GT.Y) THEN
  113.           NX = 8
  114.           NY = 5
  115.       ELSE
  116.           NX = 5
  117.           NY = 8
  118.       END IF
  119.       DX = MIN(X/NX, 0.95*Y/NY)
  120.       DY = DX
  121.       IX = NX
  122.       JY = 1
  123.       XOFF = X1 + (X-NX*DX)*0.5
  124.       YOFF = Y1 + (0.95*Y-NY*DY)*0.5
  125.       CALL PGBBUF
  126. C
  127. C Each symbol will be drawn in a standard window; the window is moved
  128. C by manipulating the viewport.
  129. C
  130.       CALL PGSWIN(-1.,1.,-1.,1.)
  131. C
  132. C Loop through all known symbols (N=0-31 and -1 to -8). 
  133. C
  134.       DO 10 N=0,39
  135.           IF (N.LE.31) WRITE (LABEL,'(I2)') N
  136.           IF (N.GT.31) WRITE (LABEL,'(I2)') 31-N
  137. C
  138. C Define window and viewport. The loop allows the plot to extend over
  139. C more than one page if necessary; each page is labelled at the top.
  140. C
  141.           IX = IX+1
  142.           IF (IX.GT.NX) THEN
  143.             IX = 1
  144.             JY = JY-1
  145.           END IF
  146.           IF (JY.LT.1) THEN
  147.             JY = NY
  148.             IF (N.NE.0) CALL PGPAGE
  149.             CALL PGSCH(1.2)
  150.             CALL PGVSIZ(XOFF, XOFF+NX*DX, YOFF, YOFF+NY*DY)
  151.             CALL PGSLW(LW)
  152.             CALL PGMTXT('T', 1.0, 0.5, 0.5,
  153.      1                   '\fiPGPLOT \frMarker Symbols')
  154.           END IF
  155.           CALL PGVSIZ(XOFF+(IX-1)*DX, XOFF+IX*DX,
  156.      1                 YOFF+(JY-1)*DY, YOFF+JY*DY)
  157. C
  158. C Call PGBOX to draw a box and PGMTXT to label it.
  159. C
  160.           CALL PGSLW(1)
  161.           CALL PGBOX('BC',10.0,0,'BC',10.0,0)
  162.           CALL PGSCH(0.5)
  163.           CALL PGMTXT('T',-1.5,0.05,0.0,LABEL)
  164. C
  165. C Call PGPT1 to draw the symbol.
  166. C
  167.           CALL PGSLW(LW)
  168.           CALL PGSCH(1.5)
  169.           IF (N.LE.31) CALL PGPT1(0.0,0.0,N)
  170.           IF (N.GT.31) CALL PGPT1(0.0,0.0,31-N)
  171.    10 CONTINUE
  172. C
  173.       CALL PGEBUF
  174. C-----------------------------------------------------------------------
  175.       END
  176.  
  177.       SUBROUTINE PGEX23
  178. C-----------------------------------------------------------------------
  179. C Demonstration program for the PGPLOT plotting package. 
  180. C-----------------------------------------------------------------------
  181.       INTEGER N
  182.       PARAMETER (N=9)
  183.       INTEGER I
  184.       REAL X1, Y1
  185.       CHARACTER*80 SAMPLE(N)
  186.       DATA SAMPLE/
  187.      1 'Normal:  \fnABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW',
  188.      2 'Roman:  \frABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW',
  189.      3 'Italic:  \fiABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW',
  190.      4 'Script:  \fsABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW',
  191.      5 '\fif\fr(\fix\fr) = \fix\fr\u2\dcos(2\gp\fix\fr)e\u\fix\fr\u2',
  192.      6 '\fiH\d0\u \fr= 75 \(2233) 25 km s\u-1\d Mpc\u-1\d',
  193.      7 '\fsL/L\d\(2281)\u\fr = 5\.6 \x 10\u6\d (\gl1216\A)',
  194.      8 'Markers: 3=\m3, 8=\m8, 12=\m12, 28=\m28.',
  195.      9 'Cyrillic: \(2830)\(2912)\(2906)\(2911)\(2919)\(2917)\(2915).'/
  196. C
  197. C Call PGENV to initialize the viewport and window.
  198. C Call PGLAB to label the graph.
  199. C
  200.       CALL PGENV(0.,20.,REAL(N),0.,0,-2)
  201.       CALL PGLAB(' ',' ','\fiPGPLOT \frFonts')
  202. C
  203. C Use PGTEXT to write the sample character strings.
  204. C
  205.       CALL PGSCH(1.6)
  206.       DO 10 I=1,N
  207.          X1 = 0.0
  208.          Y1 = REAL(I)-0.5
  209.          CALL PGTEXT(X1, Y1, SAMPLE(I))
  210.  10    CONTINUE
  211.       CALL PGSCH(1.0)
  212. C-----------------------------------------------------------------------
  213.       END
  214.  
  215.       SUBROUTINE PGEX24
  216. C-----------------------------------------------------------------------
  217. C Demonstration program for the PGPLOT plotting package. This example
  218. C illustrates the different line widths.
  219. C                              T. J. Pearson  1982 Dec 28
  220. C----------------------------------------------------------------------
  221.       INTEGER IW
  222.       REAL X(2), Y(2)
  223. C
  224. C Call PGENV to initialize the viewport and window.
  225. C
  226.       CALL PGBBUF
  227.       CALL PGENV(0.,15.,0.,15.,0,0)
  228. C
  229. C Call PGLAB to label the graph.
  230. C
  231.       CALL PGLAB('Line Width',' ','\fiPGPLOT \frLine Widths')
  232. C
  233. C Draw 14 oblique lines in different thicknesses.
  234. C
  235.       DO 10 IW=1,14
  236.           X(1) = IW
  237.           Y(1) = 0.0
  238.           X(2) = 0.0
  239.           Y(2) = IW
  240.           CALL PGSLW(IW)
  241.           CALL PGLINE(2,X,Y)
  242.    10 CONTINUE
  243. C
  244. C Draw another set of lines, dashed instead of solid.
  245. C
  246.       CALL PGSLS(2)
  247.       DO 20 IW=1,14
  248.           X(1) = IW
  249.           Y(1) = 15.0
  250.           X(2) = 15.0
  251.           Y(2) = IW
  252.           CALL PGSLW(IW)
  253.           CALL PGLINE(2,X,Y)
  254.    20 CONTINUE
  255. C
  256.       CALL PGSLS(1)
  257.       CALL PGSLW(1)
  258.       CALL PGEBUF
  259. C-----------------------------------------------------------------------
  260.       END
  261.  
  262.       SUBROUTINE PGEX25
  263. C-----------------------------------------------------------------------
  264. C Demonstration program for the PGPLOT plotting package. This program
  265. C tests polygon clipping on polygons and circles, and tests that
  266. C markers are clipped correctly. Note that markers exactly on the edge
  267. C of the window are supposed to be visible.
  268. C                              T. J. Pearson  1994 Nov 25
  269. C-----------------------------------------------------------------------
  270.       INTEGER I, J
  271.       REAL PX(43), PY(43), SX(5), SY(5), RX(3), RY(3)
  272.       DATA PX / 0.0,2.0,4.0,6.0,8.0,10.0,12.0,14.0,16.4,17.0,17.3,
  273.      1          17.8, 18.5, 20.0, 22.0, 24.0, 26.0, 28.0, 29.0,
  274.      2          28.8,27.2,25.0,23.0,21.5,21.1,21.5,22.8, 24.1, 25.1,
  275.      3          25.2, 24.2, 22.1, 20.0, 18.0, 16.0, 14.0, 12.0,
  276.      4          10.0,  8.0,  6.1,  4.2,  3.0,  1.3 /
  277.       DATA PY / 8.8, 7.6, 7.1, 7.4, 8.0, 8.9, 9.6, 9.9, 9.4,
  278.      1          9.7, 12.0, 14.0, 16.1, 17.0, 17.0, 16.0, 13.9,
  279.      2          13.1, 13.2, 12.3, 11.5, 11.5, 11.5, 11.2, 10.5,
  280.      3          9.0, 8.0, 7.0, 5.1, 3.6, 1.9, 1.1, 0.9, 0.7,
  281.      4          0.8, 1.0, 1.0, 1.2, 1.8, 2.1, 2.9, 4.1, 6.0 /
  282.       DATA SX / 10.0, 10.0, 20.0, 30.0, 15.0 /
  283.       DATA SY /  0.0, -6.0, -6.0,  5.0, -3.5 /
  284.       DATA RX / 26.0, 27.0, 26.0 /
  285.       DATA RY / -4.0, -3.0, -3.0 /
  286. C
  287.       CALL PGPAGE
  288.       CALL PGVSTD
  289.       CALL PGBBUF
  290.       CALL PGSAVE
  291. C
  292. C Set window.
  293. C
  294.       CALL PGWNAD(5.0, 25.0, -5.0, 15.0)
  295.       CALL PGSCI(1)
  296.       CALL PGSLW(1)
  297.       CALL PGBOX('BCNST', 0.0, 0, 'BCNST', 0.0, 0)
  298. C
  299. C Test clipping of polygons and circles
  300. C
  301.       CALL PGSFS(1)
  302.       CALL PGSCI(2)
  303.       CALL PGPOLY(43, PX, PY)
  304.       CALL PGSCI(0)
  305.       CALL PGSFS(3)
  306.       CALL PGSHS(30.0, 2.0, 0.0)
  307.       CALL PGPOLY(43, PX, PY)
  308.       CALL PGSCI(1)
  309.       CALL PGSHS(30.0, 4.0, 0.25)
  310.       CALL PGPOLY(43, PX, PY)
  311.       CALL PGSCI(1)
  312.       CALL PGSFS(2)
  313.       CALL PGPOLY(43, PX, PY)
  314. C
  315.       CALL PGSFS(1)
  316.       CALL PGSCI(4)
  317.       CALL PGPOLY(5, SX, SY)
  318.       CALL PGSCI(0)
  319.       CALL PGSFS(4)
  320.       CALL PGSHS(0.0, 1.6, 0.0)
  321.       CALL PGPOLY(5, SX, SY)
  322.       CALL PGSCI(1)
  323.       CALL PGSFS(2)
  324.       CALL PGPOLY(5, SX, SY)
  325. C     
  326. C       The next polygon should be invisible.
  327.       CALL PGSFS(1)
  328.       CALL PGSCI(4)
  329.       CALL PGPOLY(3, RX, RY)
  330.       CALL PGSCI(1)
  331.       CALL PGSFS(2)
  332.       CALL PGPOLY(3, RX, RY)
  333. C
  334.       CALL PGSFS(1)
  335.       CALL PGSCI(3)
  336.       CALL PGCIRC(8.0, 12.0, 3.5)
  337.       CALL PGSFS(2)
  338.       CALL PGSCI(1)
  339.       CALL PGCIRC(8.0, 12.0, 3.5)
  340. C
  341. C Test clipping of markers: all should be visible.
  342. C
  343.       CALL PGSCI(1)
  344.       CALL PGSLW(1)
  345.       DO 20 I=0,30,5
  346.          DO 10 J=-5,25,5
  347.             CALL PGPT1(REAL(I),REAL(J),9)
  348.  10      CONTINUE
  349.  20   CONTINUE
  350. C
  351. C Draw box.
  352. C
  353.       CALL PGBOX('BCNST', 0.0, 0, 'BCNST', 0.0, 0)
  354.       CALL PGLAB(' ', ' ', 'PGPLOT: clipping polygons and markers')
  355. C
  356.       CALL PGUNSA
  357.       CALL PGEBUF
  358. C-----------------------------------------------------------------------
  359.       END
  360.  
  361.       SUBROUTINE PGEX26
  362. C-----------------------------------------------------------------------
  363.       CHARACTER*128 DEVICE
  364.       CHARACTER*80 GTYPE, GVER
  365.       INTEGER I, J, L, L1, L2
  366.       REAL X, X1, X2, Y, Y1, Y2, R, XI, XP, YP
  367.       REAL PX(43), PY(43)
  368.       DATA PX / 0.0,2.0,4.0,6.0,8.0,10.0,12.0,14.0,16.4,17.0,17.3,
  369.      1          17.8, 18.5, 20.0, 22.0, 24.0, 26.0, 28.0, 29.0,
  370.      2          28.8,27.2,25.0,23.0,21.5,21.1,21.5,22.8, 24.1, 25.1,
  371.      3          25.2, 24.2, 22.1, 20.0, 18.0, 16.0, 14.0, 12.0,
  372.      4          10.0,  8.0,  6.1,  4.2,  3.0,  1.3 /
  373.       DATA PY / 8.8, 7.6, 7.1, 7.4, 8.0, 8.9, 9.6, 9.9, 9.4,
  374.      1          9.7, 12.0, 14.0, 16.1, 17.0, 17.0, 16.0, 13.9,
  375.      2          13.1, 13.2, 12.3, 11.5, 11.5, 11.5, 11.2, 10.5,
  376.      3          9.0, 8.0, 7.0, 5.1, 3.6, 1.9, 1.1, 0.9, 0.7,
  377.      4          0.8, 1.0, 1.0, 1.2, 1.8, 2.1, 2.9, 4.1, 6.0 /
  378. C
  379.       CALL PGQINF('DEV/TYPE', DEVICE, L)
  380.       CALL PGQINF('VERSION', GVER, L1)
  381.       CALL PGQINF('TYPE', GTYPE, L2)
  382.       CALL PGBBUF
  383. C
  384. C Clear the screen; set background and foreground colors.
  385. C
  386.       CALL PGPAGE
  387.       CALL PGSCR(0,0.0,0.0,0.35)
  388.       CALL PGSCR(1,1.0,1.0,1.0)
  389.       CALL PGERAS
  390. C
  391. C Draw a frame at the physical extremities of the plot.
  392. C Dimensions are X by Y (inches).
  393. C
  394.       CALL PGSVP(0.0, 1.0, 0.0, 1.0)
  395.       CALL PGQVP(1, X1, X2, Y1, Y2)
  396.       X = X2-X1
  397.       Y = Y2-Y1
  398.       CALL PGSWIN(0.0, X, 0.0, Y)
  399.       CALL PGSFS(2)
  400.       CALL PGRECT(0.0, X, 0.0, Y)
  401.       CALL PGMOVE(0.5*X, 0.0)
  402.       CALL PGDRAW(0.5*X, Y)
  403.       CALL PGMOVE(0.0, 0.5*Y)
  404.       CALL PGDRAW(X, 0.5*Y)
  405. C
  406. C Draw a circle of diameter 0.5 x min(x,y)
  407. C
  408.       R = 0.25*MIN(X,Y)
  409.       CALL PGCIRC(X*0.5, Y*0.5, R)
  410. C
  411. C Draw some more circles with different line-styles; this tests
  412. C the dashing algorithm on curved lines.
  413. C
  414.       CALL PGSLS(2)
  415.       CALL PGCIRC(X*0.5, Y*0.5, R*1.1)
  416.       CALL PGSLS(3)
  417.       CALL PGCIRC(X*0.5, Y*0.5, R*1.2)
  418.       CALL PGSLS(2)
  419.       CALL PGSLW(3)
  420.       CALL PGCIRC(X*0.5, Y*0.5, R*1.3)
  421.       CALL PGSLS(1)
  422.       CALL PGSLW(1)      
  423. C
  424. C Demonstrate different line-styles
  425. C
  426.       DO 10 I=1,5
  427.           CALL PGSLS(I)
  428.           CALL PGMOVE(I*(X/20.0),0.0)
  429.           CALL PGDRAW(I*(X/20.0),Y)
  430.    10 CONTINUE
  431.       CALL PGSLS(1)
  432. C
  433. C Demonstrate different line-widths
  434. C
  435.       DO 20 I=1,5
  436.           CALL PGSLW(I)
  437.           CALL PGMOVE(0.0, I*(Y/20.0))
  438.           CALL PGDRAW(X, I*(Y/20.0))
  439.    20 CONTINUE
  440.       CALL PGSLW(1)
  441. C
  442. C Demonstrate different line-colors
  443. C
  444.       CALL PGSLW(4)
  445.       DO 40 I=0,15
  446.           CALL PGSCI(I)
  447.           XI = (I+20)*(X/40.0)
  448.           CALL PGMOVE(XI,0.0)
  449.           CALL PGDRAW(XI,Y)
  450.    40 CONTINUE
  451.       CALL PGSCI(1)
  452.       CALL PGSLW(1)
  453. C
  454. C Draw dots in different thicknesses.
  455. C
  456.       XP = (14+20)*(X/40.0)
  457.       DO 30 I=1,21
  458.           YP = I*Y/22.0
  459.           CALL PGSLW(I)
  460.           CALL PGPT1(XP,YP,-1)
  461.    30 CONTINUE
  462.       CALL PGSLW(1)
  463. C
  464. C Demonstrate fill area
  465. C
  466.       DO 50 J=1,43
  467.          PX(J) = (PX(J)+50.0)/100.0*X
  468.          PY(J) = (PY(J)+75.0)/100.0*Y
  469.    50 CONTINUE
  470.       DO 70 I=0,3
  471.           CALL PGSCI(I)
  472.           CALL PGSFS(1)
  473.           CALL PGPOLY(43,PX,PY)
  474.           CALL PGSCI(1)
  475.           CALL PGSFS(2)
  476.           CALL PGPOLY(43,PX,PY)
  477.           DO 60 J=1,43
  478.              PY(J) = PY(J)-0.25*Y
  479.    60     CONTINUE
  480.    70 CONTINUE
  481. C
  482. C Write the device type on the plot.
  483. C
  484.       CALL PGSWIN(0.0, 1.0, 0.0, 1.0)
  485.       CALL PGSFS(1)
  486.       CALL PGSCI(0)
  487.       CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97)
  488.       CALL PGSCI(1)
  489.       CALL PGSFS(2)
  490.       CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97)
  491.       CALL PGPTXT(0.5, 0.91, 0.0, 0.5, 'PGPLOT '//GVER(1:L1))
  492.       CALL PGPTXT(0.5, 0.87, 0.0, 0.5, 'Device '//GTYPE(1:L2))
  493. C
  494.       CALL PGEBUF
  495. C-----------------------------------------------------------------------
  496.       END
  497.