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