aboutsummaryrefslogtreecommitdiff
path: root/plotlib/examples/spectrum.f
diff options
context:
space:
mode:
Diffstat (limited to 'plotlib/examples/spectrum.f')
-rw-r--r--plotlib/examples/spectrum.f143
1 files changed, 143 insertions, 0 deletions
diff --git a/plotlib/examples/spectrum.f b/plotlib/examples/spectrum.f
new file mode 100644
index 0000000..fadf1f5
--- /dev/null
+++ b/plotlib/examples/spectrum.f
@@ -0,0 +1,143 @@
+C***********************************************************************
+C Module: spectrum.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 spectrum
+C
+C Displays chosen COLORSPECTRUMDEFAULT colors in a circle and bar
+C
+C
+ dimension xp(100), yp(100)
+C
+ CHARACTER*12 HUES
+ CHARACTER*4 INP
+ CH = 0.02
+C
+ PI = 4.0*ATAN(1.0)
+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) INP
+ ips = -1
+ if(INP.ne.' ') then
+ READ(INP,*,end=2000,err=2000) ips
+ endif
+ IDEV = 1
+ IF(ips.eq.0) IDEV = 3
+ IF(ips.ge.1) IDEV = 5
+ ipslu = 0
+C
+C---- for REPLOT: X11 only
+ IDEVRP = 1
+ CALL PLINITIALIZE
+C
+C---Now, how many colors...
+ WRITE(*,*) ' Enter number of colors'
+ READ(*,1000,end=2000) INP
+ ncolors = 128
+ if(INP.ne.' ') then
+ READ(INP,*,end=2000,err=2000) ncolors
+ endif
+C
+ WRITE(*,*) ' Specify hue string (out of ROYGCBM)'
+ READ (*,1000) HUES
+ IF(HUES.EQ.' ') HUES = 'ROYGCBM'
+C
+C---Set up colormap spectrum colors
+ if(ncolors.LE.1) ncolors = 0
+ CALL COLORSPECTRUMHUES(ncolors,HUES)
+C
+C---- radius of circle
+ rad = 3.0
+c
+ CALL PLOPEN(0.7,ipslu,IDEV)
+ CALL PLOT(1.3*rad,1.3*rad,-3)
+c
+c---- plot circle
+ do ii = 1,ncolors
+ call NEWCOLOR(-ii)
+ t0 = float(ii-1)/float(ncolors) ! + 0.167
+ t1 = float(ii )/float(ncolors) ! + 0.167
+C
+ xp(1) = 0.0
+ yp(1) = 0.0
+ xp(2) = rad*cos(2.0*pi*t0)
+ yp(2) = rad*sin(2.0*pi*t0)
+ xp(3) = rad*cos(2.0*pi*(t0+0.25*(t1-t0)))
+ yp(3) = rad*sin(2.0*pi*(t0+0.25*(t1-t0)))
+ xp(4) = rad*cos(2.0*pi*(t0+0.50*(t1-t0)))
+ yp(4) = rad*sin(2.0*pi*(t0+0.50*(t1-t0)))
+ xp(5) = rad*cos(2.0*pi*(t0+0.75*(t1-t0)))
+ yp(5) = rad*sin(2.0*pi*(t0+0.75*(t1-t0)))
+ xp(6) = rad*cos(2.0*pi*t1)
+ yp(6) = rad*sin(2.0*pi*t1)
+ call POLYLINE(xp,yp,6,1)
+ end do
+C
+ CALL PLOT(1.5*rad,-rad,-3)
+C
+c---- plot bar
+ dx = 1.0
+ dy = 2.0*rad/float(ncolors)
+ do ii = 1,ncolors
+ call NEWCOLOR(-ii)
+c
+ x0 = 0.0
+ y0 = dy*float(ii-1)
+c
+ xp(1) = x0
+ yp(1) = y0
+ xp(2) = x0+dx
+ yp(2) = y0
+ xp(3) = x0+dx
+ yp(3) = y0+dy
+ xp(4) = x0
+ yp(4) = y0+dy
+ call POLYLINE(xp,yp,4,1)
+ end do
+C
+ CALL NEWCOLORNAME('black')
+ CALL PLOTABS(1.,.75,-3)
+ CALL PLCHAR (999.,999.,.1,'SPECTRUM ',0.,+10)
+ CALL PLCHAR (999.,999.,.1,HUES,0.,LEN(HUES))
+ CALL PLOTABS(1.,0.5,-3)
+ CALL PLCHAR (999.,999.,.1,'Ncolors = ',0.,+10)
+ CALL PLNUMB (999.,999.,.1,FLOAT(ncolors),0.,-1)
+C
+ CALL PLFLUSH
+ WRITE(*,*) 'Hit return to test replot'
+ READ(5,1000) DUMMY
+C
+ CALL REPLOT(IDEVRP)
+ CALL PLFLUSH
+C
+ WRITE(*,*) 'Hit return to end test'
+ READ(5,1000) DUMMY
+ 1000 FORMAT(A)
+C
+C GO TO 1
+C
+ 2000 CALL PLOT(0.0,0.0,+999)
+ STOP
+ END