1
! $Id: x11f.f90,v 1.1 2006/05/16 20:24:12 airwin Exp $
4
! Copyright (C) 2004 Alan W. Irwin
6
! This file is part of PLplot.
8
! PLplot is free software; you can redistribute it and/or modify
9
! it under the terms of the GNU General Library Public License as
10
! published by the Free Software Foundation; either version 2 of the
11
! License, or (at your option) any later version.
13
! PLplot is distributed in the hope that it will be useful,
14
! but WITHOUT ANY WARRANTY; without even the implied warranty of
15
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16
! GNU Library General Public License for more details.
18
! You should have received a copy of the GNU Library General Public
19
! License along with PLplot; if not, write to the Free Software
20
! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22
use plplot, PI => PL_PI
24
integer i, j, k, ifshade, xpts, ypts
25
parameter (xpts=35, ypts=46)
27
real(kind=plflt) x(xpts), y(ypts), z(xpts,ypts), xx, yy, r
30
real(kind=plflt) alt(2),az(2)
32
data alt /33.0_plflt,17.0_plflt/
33
data az /24.0_plflt,115.0_plflt/
36
data title /'#frPLplot Example 11 - Alt=33, Az=24, Opt=3', &
37
'#frPLplot Example 11 - Alt=17, Az=115, Opt=3'/
39
parameter (nlevel = 10)
40
real(kind=plflt) zmin, zmax, step, clevel(nlevel)
41
! Plotting options for 3d plots, see plplot.h for the C definitions
43
integer DRAW_LINEX, DRAW_LINEY, DRAW_LINEXY, MAG_COLOR, &
44
BASE_CONT, TOP_CONT, SURF_CONT, DRAW_SIDES, FACETED, MESH
45
parameter(DRAW_LINEX = 1)
46
parameter(DRAW_LINEY = 2)
47
parameter(DRAW_LINEXY = 3)
48
parameter(MAG_COLOR = 4)
49
parameter(BASE_CONT = 8)
50
parameter(TOP_CONT = 16)
51
parameter(SURF_CONT = 32)
52
parameter(DRAW_SIDES = 64)
53
parameter(FACETED = 128)
55
! Process command-line arguments
56
call plparseopts(PL_PARSE_FULL)
60
x(i) = 3._plflt*dble(i-1-(xpts/2))/dble (xpts/2)
63
y(j) = 3._plflt*dble(j-1-(ypts/2))/dble (ypts/2)
70
z(i,j) = 3._plflt * (1._plflt-xx)*(1._plflt-xx) * &
71
exp(-(xx*xx) - (yy+1._plflt)*(yy+1._plflt)) - &
72
10._plflt * (xx/5._plflt - xx**3 - yy**5) * exp(-xx*xx-yy*yy) - &
73
1._plflt/3._plflt * exp(-(xx+1._plflt)*(xx+1._plflt) - (yy*yy))
75
! Jungfraujoch/Interlaken
76
if(z(i,j).lt.-1._plflt) z(i,j) = -1._plflt
80
call a2mnmx(z, xpts, ypts, zmin, zmax)
81
step = (zmax-zmin)/(nlevel+1)
83
clevel(i) = zmin + step*i
92
call plvpor(0.0_plflt, 1.0_plflt, 0.0_plflt, 0.9_plflt )
93
call plwind(-1.0_plflt, 1.0_plflt, -1.0_plflt, 1.5_plflt )
94
call plw3d(1.0_plflt, 1.0_plflt, 1.2_plflt, -3.0_plflt, &
95
3.0_plflt, -3.0_plflt, 3.0_plflt, zmin, zmax, alt(k),az(k))
96
call plbox3('bnstu','x axis', 0.0_plflt, 0, &
97
'bnstu', 'y axis', 0.0_plflt, 0, &
98
'bcdmnstuv','z axis', 0.0_plflt, 0)
100
if(ifshade.eq.0) then
102
call plmesh(x(:xpts), y(:ypts), z(:xpts,:ypts), &
104
elseif(ifshade.eq.1) then
105
! magnitude colored wireframe plot
106
call plmesh(x(:xpts), y(:ypts), z(:xpts,:ypts), &
107
ior(opt(k), MAG_COLOR))
108
elseif(ifshade.eq.2) then
109
! magnitude colored wireframe plot with sides
110
call plot3d(x(:xpts), y(:ypts), z(:xpts,:ypts), &
111
ior(opt(k), MAG_COLOR), .true.)
112
elseif(ifshade.eq.3) then
113
! magnitude colored wireframe plot with base contour
114
call plmeshc(x(:xpts), y(:ypts), z(:xpts,:ypts), &
115
ior(opt(k), ior(MAG_COLOR, BASE_CONT)), clevel)
117
stop 'x11f: bad logic'
120
call plmtex('t', 1.0_plflt, 0.5_plflt, 0.5_plflt, title(k))
126
!----------------------------------------------------------------------------
127
subroutine cmap1_init(gray)
128
! For gray.eq.1, basic grayscale variation from half-dark
129
! to light. Otherwise, hue variations around the front of the
130
! colour wheel from blue to green to red with constant lightness
136
real(kind=plflt) i(0:1), h(0:1), l(0:1), s(0:1)
143
! hue -- low: red (arbitrary if s=0)
145
! hue -- high: red (arbitrary if s=0)
147
! lightness -- low: half-dark
149
! lightness -- high: light
156
! This combination of hues ranges from blue to cyan to green to yellow
157
! to red (front of colour wheel) with constant lightness = 0.6
158
! and saturation = 0.8.
176
call plscmap1l(.false., i, h, l, s, rev)
179
!----------------------------------------------------------------------------
181
! Minimum and the maximum elements of a 2-d array.
183
subroutine a2mnmx(f, nx, ny, fmin, fmax)
188
real(kind=plflt) f(nx, ny), fmin, fmax
194
fmax = max(fmax, f(i, j))
195
fmin = min(fmin, f(i, j))
added
removed
examples/f95/x11f.f90
