aboutsummaryrefslogtreecommitdiff
path: root/plotlib/examples/contest.f
diff options
context:
space:
mode:
Diffstat (limited to 'plotlib/examples/contest.f')
-rw-r--r--plotlib/examples/contest.f212
1 files changed, 212 insertions, 0 deletions
diff --git a/plotlib/examples/contest.f b/plotlib/examples/contest.f
new file mode 100644
index 0000000..c4f2e33
--- /dev/null
+++ b/plotlib/examples/contest.f
@@ -0,0 +1,212 @@
+C***********************************************************************
+C Module: contest.f
+C
+C Copyright (C) 1996 Harold Youngren, Mark Drela
+C
+C This program is free software; you can redistribute it and/or modify
+C it under the terms of the GNU General Public License as published by
+C the Free Software Foundation; either version 2 of the License, or
+C (at your option) any later version.
+C
+C This program is distributed in the hope that it will be useful,
+C but WITHOUT ANY WARRANTY; without even the implied warranty of
+C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+C GNU General Public License for more details.
+C
+C You should have received a copy of the GNU General Public License
+C along with this program; if not, write to the Free Software
+C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+C
+C Report problems to: guppy@maine.com
+C or drela@mit.edu
+C***********************************************************************
+
+ program contest
+C
+C--- Test of Xplot11 quadrilateral and triangle contour primitives
+C
+ CHARACTER CHR*2, HUES*10
+ DIMENSION X(4), Y(4), Z(4)
+ DIMENSION XTRI(3), YTRI(3), ZTRI(3)
+C
+ DIMENSION XCU(50), YCU(50)
+ DIMENSION XCL(50), YCL(50)
+ DIMENSION XP(50), YP(50), NE(50)
+C
+ DATA X / 0., 1., 1., 0. /
+ DATA Y / 0., 0., 1., 1. /
+ DATA Z / 0., 1., 0., 2. /
+C
+ IDEV = 3
+ nlevel = 50
+ ncolors = 64
+ WRITE(*,*) ' '
+ WRITE(*,*) 'Contour primitives test:'
+ WRITE(*,*) ' (contour fills on single square polygon)'
+ WRITE(*,*) ' '
+ WRITE(*,*) 'Data points...'
+ do i = 1, 4
+ write(*,*) i,' x = ',X(i),' y = ',Y(i),' z = ',Z(i)
+ end do
+C
+C---Decide about what devices to plot to
+ WRITE(*,*) ' '
+ 1 WRITE(*,*) ' Enter -1 for no PS, 0 for B&W PS, 1 for color PS'
+ READ(*,1000,end=2000) CHR
+ ips = -1
+ if(CHR.ne.' ') then
+ READ(CHR,*,end=2000,err=2000) ips
+ endif
+ IDEV = 1
+ IF(ips.eq.0) IDEV = 3
+ IF(ips.ge.1) IDEV = 5
+ ipslu = 0
+C
+C--- Get contour data
+ ZL = 0.
+ ZU = 2.
+ write(*,*) ' '
+ write(*,*) 'Contour limits ',ZL,' to ',ZU
+ write(*,*) 'Enter # of contour levels'
+ read (*,*) nlevel
+C
+ ipslu = 0
+ CALL PLINITIALIZE
+ HUES = 'ROYGCBM'
+C
+C---Set up colormap spectrum colors
+ if(ncolors.LE.1) ncolors = 0
+ CALL COLORSPECTRUMHUES(ncolors,HUES)
+C
+ do ITYP = 1, 2
+C
+ CALL PLOPEN(0.5,ipslu,IDEV)
+
+ call newcolorname('green')
+ CALL PLOTABS(.75,.75,-3)
+ CALL PLCHAR (999.,999.,.1,'Contour test ',0.,-1)
+ if(ITYP.NE.2) then
+ WRITE(*,*) 'Polygon contoured and filled as quadrilateral'
+ CALL PLCHAR (999.,999.,.1,'Quadrilateral',0.,-1)
+ else
+ WRITE(*,*) 'Polygon contoured and filled as two triangles'
+ CALL PLCHAR (999.,999.,.1,'Two Triangles',0.,-1)
+ endif
+ CALL PLOT(0.,-0.5,-3)
+ CALL PLCHAR (999.,999.,.1,'Nlevels = ',0.,-1)
+ CALL PLNUMB (999.,999.,.1,FLOAT(nlevel),0.,-1)
+ CALL PLCHAR (999.,999.,.1,' Ncolors = ',0.,-1)
+ CALL PLNUMB (999.,999.,.1,FLOAT(ncolors),0.,-1)
+ CALL PLOT(2.,2.,-3)
+ call factor(4.)
+C
+C--- Set contour levels and increments
+ NCONT = NLEVEL + 1
+ DZ = (ZU-ZL)/FLOAT(NCONT)
+C
+ DO N = 1, NCONT
+ ZUPR = FLOAT(N)*DZ
+ ZLWR = FLOAT(N-1)*DZ
+C
+C--- Set color based on contour #
+ ICOL = (NCOLORS-1)*FLOAT(N-1)/FLOAT(NCONT-1) + 1
+ CALL NEWCOLOR(-ICOL)
+C
+C--- Reset the line and area counters for each level
+ NA = 0
+ NV = 0
+ NCU = 0
+ NCL = 0
+C
+ if(ITYP.NE.2) then
+C
+C--- Contour a quadrilateral
+ CALL CONTQUAD(X,Y,Z,ZUPR,ZLWR,
+ & NCU,XCU,YCU,
+ & NCL,XCL,YCL,
+ & NA,NE,NV,XP,YP)
+C
+ else
+C
+C--- Triangle contouring, use two triangles, split quad on 1-3 diagonal
+ xtri(1) = x(1)
+ ytri(1) = y(1)
+ ztri(1) = z(1)
+ xtri(2) = x(2)
+ ytri(2) = y(2)
+ ztri(2) = z(2)
+ xtri(3) = x(3)
+ ytri(3) = y(3)
+ ztri(3) = z(3)
+ CALL CONTTRI(xtri,ytri,ztri,ZUPR,ZLWR,
+ & NCU,XCU,YCU,
+ & NCL,XCL,YCL,
+ & NA,NE,NV,XP,YP)
+ xtri(1) = x(3)
+ ytri(1) = y(3)
+ ztri(1) = z(3)
+ xtri(2) = x(4)
+ ytri(2) = y(4)
+ ztri(2) = z(4)
+ xtri(3) = x(1)
+ ytri(3) = y(1)
+ ztri(3) = z(1)
+ CALL CONTTRI(xtri,ytri,ztri,ZUPR,ZLWR,
+ & NCU,XCU,YCU,
+ & NCL,XCL,YCL,
+ & NA,NE,NV,XP,YP)
+ endif
+C
+C
+C--- Plot the filled contour polygons
+ nv = 1
+ DO IA = 1, NA
+ call polyline(xp(nv),yp(nv),ne(ia),1)
+ nv = nv+ne(ia)
+ END DO
+C
+C--- Plot the contour lines (w/o color in this case).
+C Otherwise you could leave out the polygon fills and comment out the
+C color change to BLACK to get colored line contours.
+C
+ call newcolorname('BLACK')
+C--- All lower contour lines
+ do nn = 1, ncl,2
+ call plot(xcl(nn),ycl(nn),3)
+ call plot(xcl(nn+1),ycl(nn+1),2)
+ end do
+C--- And the last upper line
+ if(N.EQ.NCONT) then
+ do nn = 1, ncu,2
+ call plot(xcu(nn),ycu(nn),3)
+ call plot(xcu(nn+1),ycu(nn+1),2)
+ end do
+ endif
+C
+ END DO
+ CALL PLFLUSH
+C
+ read(*,1000) chr
+ CALL PLOT(0.,0.,-999)
+C
+ end do
+ CALL PLOT(0.,0.,+999)
+C
+ 1000 FORMAT(A)
+C
+ 2000 STOP
+ END
+
+
+
+
+
+
+
+
+
+
+
+
+
+