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
|
include <gset.h>
include "rvpackage.h"
include "rvflags.h"
# RV_DRAW_FIT - Draw the fitted function to the screen. Called in
# rv_erase_fit() to erase old fit, and from the fitting rouines and
# plot rouines so they all draw the same function.
procedure rv_draw_fit (rv, gp, is_velocity)
pointer rv #I RV struct pointer
pointer gp #I Graphics descriptor
int is_velocity #I Plot function on velocity scale?
extern cgauss1d, lorentz
pointer sp, pltx, plty
real step, xl
int i, pltnpts, nfitpts, nvars, gstati()
double rv_shift2vel()
include "rvsinc.com"
begin
# Check for exit conditions
#if (RV_INTERACTIVE(rv) == NO || gp == NULL)
if (gp == NULL || RV_FITDONE(rv) == NO || RV_ERRCODE(rv) == ERR_FIT)
return
nfitpts = RV_IEND(rv) - RV_ISTART(rv) + 1
if (RV_FITFUNC(rv) == SINC)
pltnpts = (snfit-1) * 10
else
pltnpts = 10 * nfitpts
nvars = 1
# Plot the deblended fit if that is what was done
if (IS_DBLSTAR(rv) == YES) {
call rv_plt_deblend (rv, gp, is_velocity)
return
}
call smark (sp) # Allocate space for the plt
call salloc (pltx, pltnpts, TY_REAL)
call salloc (plty, pltnpts, TY_REAL)
# Draw the computed CCF
call gseti (gp, G_WCS, 2)
if (RV_FITFUNC(rv) == CENTER1D) {
if (is_velocity == YES && RV_DCFLAG(rv) != -1) {
call gline (gp, RV_VREL(rv), WRKPIXY(rv,RV_ISHIFT(rv)),
RV_VREL(rv), WRKPIXY(rv,RV_ISHIFT(rv))+0.1)
} else {
call gline (gp, RV_SHIFT(rv), WRKPIXY(rv,RV_ISHIFT(rv)),
RV_SHIFT(rv), WRKPIXY(rv,RV_ISHIFT(rv))+0.1)
}
call gflush (gp)
call sfree (sp)
return
} else if (RV_FITFUNC(rv) == SINC) {
if (is_velocity == YES && RV_DCFLAG(rv) != -1) {
do i = 1, pltnpts
Memr[pltx+i-1] = real(rv_shift2vel(rv, Memr[splx+i-1]))
} else
call amovr (Memr[splx], Memr[pltx], pltnpts)
call amovr (Memr[sply], Memr[plty], pltnpts)
} else {
call rv_gpltsteps (rv, pltnpts, xl, step)
do i = 1, pltnpts {
Memr[pltx+i-1] = xl + (i-1) * step
switch (RV_FITFUNC(rv)) {
case GAUSSIAN:
call cgauss1d (Memr[pltx+i-1], nvars, COEFF(rv,1), 4,
Memr[plty+i-1])
case LORENTZIAN:
call lorentz (Memr[pltx+i-1], nvars, COEFF(rv,1), 4,
Memr[plty+i-1])
case PARABOLA:
call polyfit (Memr[pltx+i-1], nvars, COEFF(rv,1), 3,
Memr[plty+i-1])
}
}
if (is_velocity == YES && RV_DCFLAG(rv) != -1) {
do i = 1, pltnpts
Memr[pltx+i-1] = real(rv_shift2vel(rv, Memr[pltx+i-1]))
}
}
if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
call gseti (gp, G_PLTYPE, GL_DASHED)
call gseti (gp, G_PLCOLOR, RV_LINECOLOR(rv))
}
call gpline (gp, Memr[pltx], Memr[plty], pltnpts)
if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
call gseti (gp, G_PLTYPE, GL_SOLID)
call gseti (gp, G_PLCOLOR, C_FOREGROUND)
}
call gflush (gp)
call sfree (sp)
end
# RV_DRAW_BACKGROUND - Draw the background marker with the correct line type
# and at the same level.
procedure rv_draw_background (rv, gp)
pointer rv #I RV struct pointer
pointer gp #I Graphics pointer
real left, right
int gstati()
begin
# Check error conditions.
if (gp == NULL || RV_FITFUNC(rv) == PARABOLA)
return
if (RV_FITFUNC(rv) == CENTER1D || IS_DBLSTAR(rv) == YES)
return
if (IS_INDEF(RV_BACKGROUND(rv)) && RV_FITFUNC(rv) == SINC)
return
# Get the background window sizes.
if (RV_DTYPE(rv) == SUMMARY_PLOT) {
if (RV_DCFLAG(rv) != -1) {
left = (RV_WINL(rv) - RV_WINDOW(rv)) * RV_DELTAV(rv)
right = (RV_WINR(rv) + RV_WINDOW(rv)) * RV_DELTAV(rv)
} else {
left = RV_WINL(rv) - RV_WINDOW(rv)
right = RV_WINR(rv) + RV_WINDOW(rv)
}
} else {
left = real (RV_WINL(rv))
right = real (RV_WINR(rv))
}
# Draw the background.
if (RV_FITDONE(rv) == YES) {
# Mark the background level
if (IS_INDEF(RV_BACKGROUND(rv))) {
if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
call gseti (gp, G_PLTYPE, GL_DASHED)
call gseti (gp, G_PLCOLOR, C_GREEN)
}
call gline (gp, left, COEFF(rv,4), right, COEFF(rv,4))
if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
call gseti (gp, G_PLTYPE, GL_SOLID)
call gseti (gp, G_PLCOLOR, C_FOREGROUND)
}
} else {
if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
call gseti (gp, G_PLTYPE, GL_DASHED)
call gseti (gp, G_PLCOLOR, C_GREEN)
}
call gline (gp, left, RV_BACKGROUND(rv), right,
RV_BACKGROUND(rv))
if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
call gseti (gp, G_PLTYPE, GL_SOLID)
call gseti (gp, G_PLCOLOR, C_FOREGROUND)
}
}
} else if (!IS_INDEF(RV_BACKGROUND(rv))) {
#call gseti (gp, G_PLCOLOR, C_GREEN)
call gline (gp, left, RV_BACKGROUND(rv), left, RV_BACKGROUND(rv))
#call gseti (gp, G_PLCOLOR, C_FOREGROUND)
} else {
#call gseti (gp, G_PLCOLOR, C_GREEN)
call gline (gp, left, 0.0, right, 0.0)
#call gseti (gp, G_PLCOLOR, C_FOREGROUND)
}
end
# RV_ERASE_FIT - Erase the previous fit prior to computing new one. Points,
# function, FWHM line and background level are erased, and the underlying
# ccf in the region redrawn,
procedure rv_erase_fit (rv, redraw)
pointer rv #I RV struct pointer
bool redraw #I Redraw background?
pointer gp
real statr, rv_width()
int ledge, redge, npts
begin
# Check for exit conditions
if (RV_INTERACTIVE(rv) == NO || RV_GP(rv) == NULL)
return
if (RV_FITDONE(rv) == NO || RV_AUTODRAW(rv) == NO)
return
gp = RV_GP(rv)
redge = RV_IEND(rv) # initializations
ledge = RV_ISTART(rv)
npts = redge - ledge + 1
# First set the line and polymarker types to be black.
call gseti (gp, G_WCS, 2)
call gseti (gp, G_PLCOLOR, C_BACKGROUND)
call gseti (gp, G_PLTYPE, GL_CLEAR)
call gseti (gp, G_PMLTYPE, GL_CLEAR)
# Erase the computed CCF.
call rv_draw_fit (rv, gp, NO)
# Erase the points being used in the fit.
call gpmark (gp, WRKPIXX(rv,ledge), WRKPIXY(rv,ledge), npts, 4, 2., 2.)
call gflush (gp)
# Erase the background level.
if ((RV_FITFUNC(rv) == GAUSSIAN || RV_FITFUNC(rv) == LORENTZIAN) &&
IS_DBLSTAR(rv) == NO) {
call rv_draw_background (rv, gp)
call gflush (gp)
}
# Erase the FWHM level.
if (!IS_INDEF(RV_FWHM_Y(rv)) && IS_DBLSTAR(rv) == NO) {
statr = rv_width (rv)
call gflush (gp)
}
# Erase the computed CCF.
#call rv_draw_fit (rv, gp, NO)
# Just in case, let's also erase the residuals.
if (RV_RESDONE(rv) == YES) {
call rv_resid_plot (rv)
RV_RESDONE(rv) = NO
}
# Now redraw the ccf, with a little on each end to cover up the slop.
call gseti (gp, G_PLTYPE, GL_SOLID)
call gseti (gp, G_PLCOLOR, C_FOREGROUND)
call gseti (gp, G_PMLTYPE, GL_SOLID)
call gpline (gp, WRKPIXX(rv,max(1,ledge-4)), WRKPIXY(rv,max(1,ledge-4)),
min(npts+8,RV_CCFNPTS(rv)))
call gflush (gp)
# Redraw the background level.
if (redraw && IS_DBLSTAR(rv) == NO)
call rv_draw_background (rv, gp)
call gflush (gp)
end
# RV_GPLTSTEPS - Get the function starting and increment parameters
procedure rv_gpltsteps (rv, npts, xl, step)
pointer rv #I RV struct pointer
int npts #I Npts being plotted
real xl #O Start position
real step #O Plot increment
real dv, c2, c3, istart, iend
begin
dv = RV_DELTAV(rv) # Initialize
c2 = COEFF(rv,2)
c3 = COEFF(rv,3)
istart = WRKPIXX(rv,RV_ISTART(rv))
iend = WRKPIXX(rv,RV_IEND(rv))
switch (RV_FITFUNC(rv)) {
case PARABOLA:
xl = istart
step = abs (iend - istart) / real (npts-1)
case GAUSSIAN:
xl = c2 - (3. * sqrt(c3))
step = (c2 + (3. * sqrt(c3)) - xl) / real (npts-1)
case LORENTZIAN:
xl = c2 - (2. * c3)
step = ((c2 + (2. * c3)) - xl) / real(npts-1)
}
end
# RV_PLT_DEBLEND -- Plot the fitted model function.
procedure rv_plt_deblend (rv, gp, is_velocity)
pointer rv #I RV struct pointer
pointer gp #I Graphics descriptor
int is_velocity #I Plot on velocity axis?
real w, xval, yval
real x1, x2, y1, y2
int i, j, npts, pnpts
int i1, nsub, offset
double rv_shift2vel()
real model()
int gstati()
begin
if (gp == NULL)
return
nsub = 10
pnpts = nsub * (npts-1)
# Compute model spectrum with continuum and plot.
i1 = DBL_I1(rv)
x1 = WRKPIXX(rv,1)
npts = DBL_NFITP(rv)
if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
call gseti (gp, G_PLTYPE, GL_DASHED)
call gseti (gp, G_PLCOLOR, RV_LINECOLOR(rv))
}
do i = 1, npts-1 {
do j = 1, nsub {
offset = ((i-1)*nsub+j)-1
w = x1 + (i1+i-2) + (j-1) * 0.1
if (is_velocity == YES && RV_DCFLAG(rv) != -1)
#xval = w * RV_DELTAV(rv)
xval = real (rv_shift2vel(rv,w))
else
xval = w
yval = model (w, DBL_COEFFS(rv,1), 3*DBL_NSHIFTS(rv)+2)
yval = DBL_SCALE(rv) * yval +
(DBL_Y1(rv)+DBL_SLOPE(rv)*(w-DBL_X1(rv)))
if (i == 1 && j == 1)
call gamove (gp, xval, yval)
else
call gadraw (gp, xval, yval)
}
call gflush (gp)
}
if (gstati(gp, G_PLTYPE) != GL_CLEAR)
call gseti (gp, G_PLTYPE, GL_SOLID)
# Draw the background to the screen.
y1 = DBL_Y1(rv)
y2 = DBL_Y2(rv)
if (is_velocity == YES && RV_DCFLAG(rv) != -1) {
#x1 = DBL_X1(rv) * RV_DELTAV(rv)
#x2 = DBL_X2(rv) * RV_DELTAV(rv)
x1 = real (rv_shift2vel(rv,DBL_X1(rv)))
x2 = real (rv_shift2vel(rv,DBL_X2(rv)))
} else {
x1 = DBL_X1(rv)
x2 = DBL_X2(rv)
}
call gline (gp, x1, y1, x2, y2)
if (gstati(gp, G_PLTYPE) != GL_CLEAR) {
call gseti (gp, G_PLTYPE, GL_SOLID)
call gseti (gp, G_PLCOLOR, C_FOREGROUND)
}
call gflush (gp)
end
|
