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
|
include <error.h>
include <gset.h>
include <config.h>
include <mach.h>
include <imhdr.h>
include <xwhen.h>
include <fset.h>
define DUMMY 6
# T_CONTOUR -- Draw a contour map of a function of two variables. This is an
# interface to the NCAR CONREC routine. Rewritten 8/85 to utilize the NCAR
# GKS based utilities. User has control over device viewport, labelling
# perimeter drawing. This routine also automatically subsamples or block
# averages to the user specified resolution.
procedure t_contour()
bool perimeter, fill, pre, sub
char imsect[SZ_FNAME], label[SZ_LINE]
char device[SZ_FNAME], title[SZ_LINE], system_id[SZ_LINE]
pointer im, subras
int xres, yres, nx, ny
int tcojmp[LEN_JUMPBUF]
int ncols, nlines, epa, status, wkid
int nset, ncontours, dashpat, mode, nhi, old_onint
real interval, floor, ceiling, zero, finc, ybot
real vx1, vx2, vy1, vy2, wx1, wx2, wy1, wy2
real xs, xe, ys, ye, dmin, dmax
real clgetr()
pointer gp, gopen()
extern tco_onint()
int clgeti(), btoi()
bool clgetb(), streq(), fp_equalr()
pointer immap(), plt_getdata()
common /tcocom/ tcojmp
int ioffm, isolid, nla, nlm
real xlt, ybt, side, ext, hold[5]
int isizel, isizem, isizep, nrep, ncrt, ilab, nulbll, ioffd
common /conre4/ isizel, isizem , isizep, nrep, ncrt, ilab, nulbll,
ioffd, ext, ioffm, isolid, nla, nlm, xlt, ybt, side
int first
common /conflg/ first
common /noaolb/ hold
begin
# First of all, intialize conrec's block data before altering any
# parameters in common.
first = 1
call conbd()
# Get image section string and output device.
call clgstr ("image", imsect, SZ_FNAME)
call clgstr ("device", device, SZ_FNAME)
zero = clgetr ("zero")
floor = clgetr ("floor")
ceiling = clgetr ("ceiling")
nhi = clgeti ("nhi")
dashpat = clgeti ("dashpat")
call clgstr ("title", title, SZ_LINE)
# The user can suppress the contour labelling by setting the common
# parameter "ilab" to zero.
ilab = btoi (clgetb ("label"))
# User can specify either the number of contours or the contour
# interval, or let conrec pick a nice number. Get params and
# encode the FINC param expected by conrec.
ncontours = clgeti ("ncontours")
if (ncontours <= 0) {
interval = clgetr ("interval")
if (interval <= 0)
finc = 0
else
finc = interval
} else
finc = - abs (ncontours)
mode = NEW_FILE
if (clgetb ("append"))
mode = APPEND
xres = clgeti ("xres")
yres = clgeti ("yres")
sub = clgetb ("subsample")
pre = clgetb ("preserve")
# Map image. Retrieve values from header that will be needed.
im = immap (imsect, READ_ONLY, 0)
ncols = IM_LEN(im,1)
nlines = IM_LEN(im,2)
if (streq (title, "imtitle")) {
call strcpy (imsect, title, SZ_LINE)
call strcat (": ", title, SZ_LINE)
call strcat (IM_TITLE(im), title, SZ_LINE)
}
xs = 1.0
xe = real (ncols)
ys = 1.0
ye = real (nlines)
# Get data with proper resolution. Procedure plt_getdata returns
# a pointer to the data matrix to be contoured. The resolution
# is decreased by the specified mathod in this procedure. The
# dimensions of the data array are also returned. The image
# header pointer can be unmapped after plt_getdata is called.
nx = 0
ny = 0
subras = plt_getdata (im, sub, pre, xres, yres, nx, ny)
call imunmap (im)
call alimr (Memr[subras], nx*ny, dmin, dmax)
if (fp_equalr (dmin, dmax))
call error (1, "constant valued array, no plot drawn")
if (fp_equalr (floor, INDEF))
floor = dmin
if (fp_equalr (ceiling, INDEF))
ceiling = dmax
# The floor and ceiling are in absolute units, but the zero shift is
# applied first, so correct the numbers for the zero shift.
floor = floor - zero
ceiling = ceiling - zero
# Apply the zero point shift.
if (abs (zero) > EPSILON)
call asubkr (Memr[subras], zero, Memr[subras], nx * ny)
# Open device and make contour plot.
call gopks (STDERR)
wkid = 1
gp = gopen (device, mode, STDGRAPH)
call gopwk (wkid, DUMMY, gp)
call gacwk (wkid)
# The viewport can be set by the user. If not, the viewport is
# assumed to be centered on the device. In either case, the
# viewport to window mapping is established in pl_map_viewport
# and conrec's automatic mapping scheme is avoided by setting nset=1.
perimeter = clgetb ("perimeter")
vx1 = clgetr ("vx1")
vx2 = clgetr ("vx2")
vy1 = clgetr ("vy1")
vy2 = clgetr ("vy2")
fill = clgetb ("fill")
call pl_map_viewport (gp, nx, ny, vx1, vx2, vy1, vy2, fill, perimeter)
nset = 1
# if (perimeter) {
# # Suppress conrec's plot label generation.
# ioffm = 1
# } else {
# # Draw plain old conrec perimeter, set ioffm = 0 to enable label.
# ioffm = 0
# nset = -1
# call perim (nx - 1, 1, ny - 1, 1)
# }
# If perimeter drawing is disabled don't draw NCAR perimeter, disable
# perimeter drawing entirely.
ioffm = 1
# Install interrupt exception handler.
call zlocpr (tco_onint, epa)
call xwhen (X_INT, epa, old_onint)
# Make the contour plot. If an interrupt occurs ZSVJMP is reentered
# with an error status.
call zsvjmp (tcojmp, status)
if (status == OK) {
call conrec (Memr[subras], nx, nx, ny, floor, ceiling, finc, nset,
nhi, -dashpat)
} else {
call gcancel (gp)
call fseti (STDOUT, F_CANCEL, OK)
}
# Now find window and output text string title. The window is
# set to the full image coordinates for labelling.
if (perimeter) {
call gswind (gp, xs, xe, ys, ye)
call draw_perimeter (gp)
call ggview (gp, wx1, wx2, wy1, wy2)
call gseti (gp, G_WCS, 0)
ybot = min (wy2 + .06, 0.99)
call gtext (gp, (wx1 + wx2) / 2.0, ybot, title, "h=c;v=t;f=b;s=.7")
# Add system id banner to plot.
call gseti (gp, G_CLIP, NO)
call sysid (system_id, SZ_LINE)
ybot = max (wy1 - 0.08, 0.01)
call gtext (gp, (wx1+wx2)/2.0, ybot, system_id, "h=c;v=b;s=.5")
if (fp_equalr (hold(5), 1.0)) {
call sprintf (label, SZ_LINE,
"contoured from %g to %g, interval = %g")
call pargr (hold(1))
call pargr (hold(2))
call pargr (hold(3))
} else {
call sprintf (label, SZ_LINE,
"contoured from %g to %g, interval = %g, labels scaled by %g")
call pargr (hold(1))
call pargr (hold(2))
call pargr (hold(3))
call pargr (hold(5))
}
ybot = max (wy1 - 0.06, .03)
call gtext (gp, (wx1 + wx2) / 2.0, ybot, label, "h=c;v=b;s=.6")
}
call gswind (gp, xs, xe, ys, ye)
call gamove (gp, xe, ye)
call gdawk (wkid)
call gclwk (wkid)
call gclks ()
call mfree (subras, TY_REAL)
end
# TCO_ONINT -- Interrupt handler for the task contour. Branches back to ZSVJMP
# in the main routine to permit shutdown without an error message.
procedure tco_onint (vex, next_handler)
int vex # virtual exception
int next_handler # not used
int tcojmp[LEN_JUMPBUF]
common /tcocom/ tcojmp
begin
call xer_reset()
call zdojmp (tcojmp, vex)
end
|
