home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / utilities / utilsp / pgplot / Examples / f77 / PGdemo2 < prev    next >
Encoding:
Text File  |  1994-02-24  |  11.1 KB  |  395 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 PGBEG
  7. C
  8. C Call PGBEG to initiate PGPLOT and open the output device; PGBEG
  9. C will prompt the user to supply the device name and type.
  10. C
  11.       IF (PGBEG(0,'?',1,1) .NE. 1) 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. C
  21. C Finally, call PGEND to terminate things properly.
  22. C
  23.       CALL PGEND
  24. C-----------------------------------------------------------------------
  25.       END
  26.  
  27.       SUBROUTINE PGEX21
  28. C-----------------------------------------------------------------------
  29. C Test subroutine for PGPLOT: screen alignment and color palette.
  30. C-----------------------------------------------------------------------
  31.       INTEGER I, L1, L2
  32.       REAL X1, X2, Y1, Y2
  33.       CHARACTER*80 GTYPE, GVER
  34. C
  35. C Get PGPLOT information.
  36. C
  37.       CALL PGQINF('VERSION', GVER, L1)
  38.       CALL PGQINF('TYPE', GTYPE, L2)
  39.       CALL PGBBUF
  40. C
  41. C Alignment test: clear the screen, and draw a box and grid using
  42. C three monochrome intensities (color indices 1, 14, and 15).  The
  43. C plot uses the largest available square viewport and and unit window.
  44. C
  45.       CALL PGPAGE
  46.       CALL PGSVP(0.0,1.0,0.0,1.0)
  47.       CALL PGWNAD(0.0,1.0,0.0,1.0)
  48.       CALL PGSCI(14)
  49.       CALL PGBOX('g',0.02,1,'g',0.02,1)
  50.       CALL PGSCI(15)
  51.       CALL PGBOX('g',0.1,5,'g',0.1,5)
  52.       CALL PGSCI(1)
  53.       CALL PGBOX('bc',0.1,5,'bc',0.1,5)
  54. C
  55. C Color palette test.
  56. C
  57.       DO 20 I=0,15
  58.           CALL PGSCI(I)
  59.           X1 = 0.31 + MOD(I,4)*0.1
  60.           Y1 = 0.61 - (I/4)*0.1
  61.           X2 = X1 + 0.08
  62.           Y2 = Y1 + 0.08
  63.           CALL PGRECT(X1, X2, Y1, Y2)
  64.    20 CONTINUE
  65. C
  66. C Write the device type on the plot.
  67. C
  68.       CALL PGSCI(0)
  69.       CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97)
  70.       CALL PGSCI(1)
  71.       CALL PGSFS(2)
  72.       CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97)
  73.       CALL PGPTXT(0.5, 0.91, 0.0, 0.5, 'PGPLOT '//GVER(1:L1))
  74.       CALL PGPTXT(0.5, 0.87, 0.0, 0.5, 'Device '//GTYPE(1:L2))
  75. C
  76.       CALL PGEBUF
  77. C-----------------------------------------------------------------------
  78.       END
  79.  
  80.       SUBROUTINE PGEX22
  81. C-----------------------------------------------------------------------
  82. C Demonstration program for the PGPLOT plotting package.
  83. C Plot a table of the standard PGPLOT graph marker symbols. This
  84. C program also illustrates how windows and viewports may be manipulated.
  85. C-----------------------------------------------------------------------
  86.       CHARACTER*2 LABEL
  87.       INTEGER NX, NY, N, IX, JY, LW
  88.       REAL X, X1, X2, XOFF, Y, Y1, Y2, YOFF, DX, DY
  89.       REAL XPIX1, XPIX2, YPIX1, YPIX2, RES
  90. C
  91. C Determine size of view surface.
  92. C Lower left corner is (X1,Y1), upper right (X2, Y2) [inches].
  93. C
  94.       CALL PGPAGE
  95.       CALL PGSVP(0.0, 1.0, 0.0, 1.0)
  96.       CALL PGQVP(1, X1, X2, Y1, Y2)
  97.       X = X2-X1
  98.       Y = Y2-Y1
  99. C
  100. C Determine device resolution (pixels/inch), and use it to choose
  101. C line width.
  102. C
  103.       CALL PGQVP(3, XPIX1, XPIX2, YPIX1, YPIX2)
  104.       RES = ABS(XPIX2-XPIX1)/ABS(X)
  105.       LW = 1
  106.       IF (RES.GT.166.0) LW = 2
  107. C
  108. C Choose horizontal or vertical arrangement depending on
  109. C device aspect ratio.
  110. C
  111.       IF (X.GT.Y) THEN
  112.           NX = 8
  113.           NY = 5
  114.       ELSE
  115.           NX = 5
  116.           NY = 8
  117.       END IF
  118.       DX = MIN(X/NX, 0.95*Y/NY)
  119.       DY = DX
  120.       IX = NX
  121.       JY = 1
  122.       XOFF = X1 + (X-NX*DX)*0.5
  123.       YOFF = Y1 + (0.95*Y-NY*DY)*0.5
  124.       CALL PGBBUF
  125. C
  126. C Each symbol will be drawn in a standard window; the window is moved
  127. C by manipulating the viewport.
  128. C
  129.       CALL PGSWIN(-1.,1.,-1.,1.)
  130. C
  131. C Loop through all known symbols (N=0-31 and -1 to -8). 
  132. C
  133.       DO 10 N=0,39
  134.           IF (N.LE.31) WRITE (LABEL,'(I2)') N
  135.           IF (N.GT.31) WRITE (LABEL,'(I2)') 31-N
  136. C
  137. C Define window and viewport. The loop allows the plot to extend over
  138. C more than one page if necessary; each page is labelled at the top.
  139. C
  140.           IX = IX+1
  141.           IF (IX.GT.NX) THEN
  142.             IX = 1
  143.             JY = JY-1
  144.           END IF
  145.           IF (JY.LT.1) THEN
  146.             JY = NY
  147.             IF (N.NE.0) CALL PGPAGE
  148.             CALL PGSCH(1.2)
  149.             CALL PGVSIZ(XOFF, XOFF+NX*DX, YOFF, YOFF+NY*DY)
  150.             CALL PGSLW(LW)
  151.             CALL PGMTXT('T', 1.0, 0.5, 0.5,
  152.      1                   '\fiPGPLOT \frMarker Symbols')
  153.           END IF
  154.           CALL PGVSIZ(XOFF+(IX-1)*DX, XOFF+IX*DX,
  155.      1                 YOFF+(JY-1)*DY, YOFF+JY*DY)
  156. C
  157. C Call PGBOX to draw a box and PGMTXT to label it.
  158. C
  159.           CALL PGSLW(1)
  160.           CALL PGBOX('BC',10.0,0,'BC',10.0,0)
  161.           CALL PGSCH(0.5)
  162.           CALL PGMTXT('T',-1.5,0.05,0.0,LABEL)
  163. C
  164. C Call PGPT to draw the symbol.
  165. C
  166.           CALL PGSLW(LW)
  167.           CALL PGSCH(1.5)
  168.           IF (N.LE.31) CALL PGPT(1,0.0,0.0,N)
  169.           IF (N.GT.31) CALL PGPT(1,0.0,0.0,31-N)
  170.    10 CONTINUE
  171. C
  172.       CALL PGEBUF
  173. C-----------------------------------------------------------------------
  174.       END
  175.  
  176.       SUBROUTINE PGEX23
  177. C-----------------------------------------------------------------------
  178. C Demonstration program for the PGPLOT plotting package. 
  179. C-----------------------------------------------------------------------
  180.       INTEGER I
  181.       CHARACTER*80 SAMPLE(8)
  182.       DATA SAMPLE(1)
  183.      1 /'Normal:  \fnABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW'/
  184.       DATA SAMPLE(2)
  185.      1 /'Roman:  \frABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW'/
  186.       DATA SAMPLE(3)
  187.      1 /'Italic:  \fiABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW'/
  188.       DATA SAMPLE(4)
  189.      1 /'Script:  \fsABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW'/
  190.       DATA SAMPLE(5)
  191.      1 /'\fif\fr(\fix\fr) = \fix\fr\u2\dcos(2\gp\fix\fr)e\u\fix\fr\u2'/
  192.       DATA SAMPLE(6)
  193.      1 /'\fiH\d0\u \fr= 75 \(2233) 25 km s\u-1\d Mpc\u-1\d'/
  194.       DATA SAMPLE(7)
  195.      1 /'\fsL/L\d\(2281)\u\fr = 5.6 (\gl1216\A)'/
  196.       DATA SAMPLE(8)
  197.      1 /'Markers: 3=\m3, 8=\m8, 12=\m12, 28=\m28.'/
  198. C
  199. C Call PGENV to initialize the viewport and window.
  200. C Call PGLAB to label the graph.
  201. C
  202.       CALL PGENV(0.,20.,8.,0.,0,-2)
  203.       CALL PGLAB(' ',' ','\fiPGPLOT \frFonts')
  204. C
  205. C Use PGTEXT to write the sample character strings.
  206. C
  207.       CALL PGSCH(1.6)
  208.       DO 10 I=1,8
  209.           CALL PGTEXT(0.0,FLOAT(I),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.       CHARACTER*128 DEVICE
  265.       CHARACTER*80 GTYPE, GVER
  266.       INTEGER I, J, L, L1, L2
  267.       REAL X, X1, X2, Y, Y1, Y2, R, XI, XP, YP
  268.       REAL PX(43), PY(43)
  269.       DATA PX / 0.0,2.0,4.0,6.0,8.0,10.0,12.0,14.0,16.4,17.0,17.3,
  270.      1          17.8, 18.5, 20.0, 22.0, 24.0, 26.0, 28.0, 29.0,
  271.      2          28.8,27.2,25.0,23.0,21.5,21.1,21.5,22.8, 24.1, 25.1,
  272.      3          25.2, 24.2, 22.1, 20.0, 18.0, 16.0, 14.0, 12.0,
  273.      4          10.0,  8.0,  6.1,  4.2,  3.0,  1.3 /
  274.       DATA PY / 8.8, 7.6, 7.1, 7.4, 8.0, 8.9, 9.6, 9.9, 9.4,
  275.      1          9.7, 12.0, 14.0, 16.1, 17.0, 17.0, 16.0, 13.9,
  276.      2          13.1, 13.2, 12.3, 11.5, 11.5, 11.5, 11.2, 10.5,
  277.      3          9.0, 8.0, 7.0, 5.1, 3.6, 1.9, 1.1, 0.9, 0.7,
  278.      4          0.8, 1.0, 1.0, 1.2, 1.8, 2.1, 2.9, 4.1, 6.0 /
  279. C
  280.       CALL PGQINF('DEV/TYPE', DEVICE, L)
  281.       CALL PGQINF('VERSION', GVER, L1)
  282.       CALL PGQINF('TYPE', GTYPE, L2)
  283.       CALL PGBBUF
  284. C
  285. C Clear the screen; set background color.
  286. C
  287.       CALL PGPAGE
  288.       CALL PGSCR(0,0.0,0.0,0.35)
  289. C
  290. C Draw a frame at the physical extremities of the plot.
  291. C Dimensions are X by Y (inches).
  292. C
  293.       CALL PGSVP(0.0, 1.0, 0.0, 1.0)
  294.       CALL PGQVP(1, X1, X2, Y1, Y2)
  295.       X = X2-X1
  296.       Y = Y2-Y1
  297.       CALL PGSWIN(0.0, X, 0.0, Y)
  298.       CALL PGSFS(2)
  299.       CALL PGRECT(0.0, X, 0.0, Y)
  300.       CALL PGMOVE(0.5*X, 0.0)
  301.       CALL PGDRAW(0.5*X, Y)
  302.       CALL PGMOVE(0.0, 0.5*Y)
  303.       CALL PGDRAW(X, 0.5*Y)
  304. C
  305. C Draw a circle of diameter 0.5 x min(x,y)
  306. C
  307.       R = 0.25*MIN(X,Y)
  308.       CALL PGCIRC(X*0.5, Y*0.5, R)
  309. C
  310. C Draw some more circles with different line-styles; this tests
  311. C the dashing algorithm on curved lines.
  312. C
  313.       CALL PGSLS(2)
  314.       CALL PGCIRC(X*0.5, Y*0.5, R*1.1)
  315.       CALL PGSLS(3)
  316.       CALL PGCIRC(X*0.5, Y*0.5, R*1.2)
  317.       CALL PGSLS(2)
  318.       CALL PGSLW(3)
  319.       CALL PGCIRC(X*0.5, Y*0.5, R*1.3)
  320.       CALL PGSLS(1)
  321.       CALL PGSLW(1)      
  322. C
  323. C Demonstrate different line-styles
  324. C
  325.       DO 10 I=1,5
  326.           CALL PGSLS(I)
  327.           CALL PGMOVE(I*(X/20.0),0.0)
  328.           CALL PGDRAW(I*(X/20.0),Y)
  329.    10 CONTINUE
  330.       CALL PGSLS(1)
  331. C
  332. C Demonstrate different line-widths
  333. C
  334.       DO 20 I=1,5
  335.           CALL PGSLW(I)
  336.           CALL PGMOVE(0.0, I*(Y/20.0))
  337.           CALL PGDRAW(X, I*(Y/20.0))
  338.    20 CONTINUE
  339.       CALL PGSLW(1)
  340. C
  341. C Draw dots in different thicknesses.
  342. C
  343.       DO 30 I=1,21
  344.           XP = 6*Y/20.0
  345.           YP = I*Y/22.0
  346.           CALL PGSLW(I)
  347.           CALL PGPT(1,XP,YP,-1)
  348.    30 CONTINUE
  349. C
  350. C Demonstrate different line-colors
  351. C
  352.       CALL PGSLW(4)
  353.       DO 40 I=0,15
  354.           CALL PGSCI(I)
  355.           XI = (I+20)*(X/40.0)
  356.           CALL PGMOVE(XI,0.0)
  357.           CALL PGDRAW(XI,Y)
  358.    40 CONTINUE
  359.       CALL PGSCI(1)
  360.       CALL PGSLW(1)
  361. C
  362. C Demonstrate fill area
  363. C
  364.       DO 50 J=1,43
  365.          PX(J) = (PX(J)+50.0)/100.0*X
  366.          PY(J) = (PY(J)+75.0)/100.0*Y
  367.    50 CONTINUE
  368.       DO 70 I=0,3
  369.           CALL PGSCI(I)
  370.           CALL PGSFS(1)
  371.           CALL PGPOLY(43,PX,PY)
  372.           CALL PGSCI(1)
  373.           CALL PGSFS(2)
  374.           CALL PGPOLY(43,PX,PY)
  375.           DO 60 J=1,43
  376.              PY(J) = PY(J)-0.25*Y
  377.    60     CONTINUE
  378.    70 CONTINUE
  379. C
  380. C Write the device type on the plot.
  381. C
  382.       CALL PGSWIN(0.0, 1.0, 0.0, 1.0)
  383.       CALL PGSFS(1)
  384.       CALL PGSCI(0)
  385.       CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97)
  386.       CALL PGSCI(1)
  387.       CALL PGSFS(2)
  388.       CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97)
  389.       CALL PGPTXT(0.5, 0.91, 0.0, 0.5, 'PGPLOT '//GVER(1:L1))
  390.       CALL PGPTXT(0.5, 0.87, 0.0, 0.5, 'Device '//GTYPE(1:L2))
  391. C
  392.       CALL PGEBUF
  393. C-----------------------------------------------------------------------
  394.       END
  395.