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 <mach.h>
include "sensfunc.h"
define KEY "noao$onedspec/sensfunc/sensfunc.key"
define PROMPT "sensfunc options"
# SF_SENSFUNC -- Interactive sensitivity function determination.
procedure sf_sensfunc (gp, stds, nstds, wextn, extn, nextn, sensimage, logfile,
ecv, function, order, ignoreaps, interactive)
pointer gp # Graphics structure
pointer stds[nstds] # Pointer to standard observations
int nstds # Number of standards
real wextn[nextn] # Extinction table wavelengths
real extn[nextn] # Extinction table values
int nextn # Number of extinction table values
char sensimage[ARB] # Output rootname
char logfile[ARB] # Statistics filename
pointer ecv # Residual extinction curve
char function[ARB] # Fitting function type
int order # Function order
bool ignoreaps # Ignore apertures?
int interactive # Interactive?
char cmd[SZ_FNAME]
int wc, key, newgraph, newfit
real wx, wy
int i, j, aperture, shift, npts, fd, open()
real xmin, xmax, rms, delta
pointer cv
int clgcur(), scan(), nscan(), clgwrd()
errchk open
define output_ 99
begin
# Initialize data and do the initial fit.
call sf_reset (stds, nstds, wextn, extn, nextn, ecv, shift)
xmin = MAX_REAL
xmax = -MAX_REAL
do i = 1, nstds - 2 {
if (STD_FLAG(stds[i]) == SF_EXCLUDE)
next
aperture = STD_BEAM(stds[i])
xmin = min (xmin, STD_WSTART(stds[i]), STD_WEND(stds[i]))
xmax = max (xmax, STD_WSTART(stds[i]), STD_WEND(stds[i]))
}
cv = NULL
call sf_fit (stds, nstds, cv, function, order, xmin, xmax)
call sf_rms (stds, nstds, rms, npts)
# If not interactive go to the output.
if (interactive == 3)
goto output_
if (interactive != 4) {
call printf ("Fit aperture %d interactively? ")
call pargi (aperture)
interactive = clgwrd ("answer", cmd, SZ_FNAME, "|no|yes|NO|YES")
switch (interactive) {
case 1:
goto output_
case 3:
call sf_gfree (gp)
goto output_
}
}
# Initialize graphics structure parameters: airmass and wavelength
# limits and default images to plot.
if (gp == NULL)
call sf_ginit (gp)
GP_AIRMASS(gp,1) = MAX_REAL
GP_AIRMASS(gp,2) = -MAX_REAL
j = 0
do i = 1, nstds - 2 {
if (STD_FLAG(stds[i]) == SF_EXCLUDE)
next
GP_AIRMASS(gp,1) = min (GP_AIRMASS(gp,1), STD_AIRMASS(stds[i]))
GP_AIRMASS(gp,2) = max (GP_AIRMASS(gp,2), STD_AIRMASS(stds[i]))
if (j < SF_NGRAPHS) {
j = j + 1
call strcpy (STD_IMAGE(stds[i]), Memc[GP_IMAGES(gp,j)],
SZ_FNAME)
call strcpy (STD_SKY(stds[i]), Memc[GP_SKYS(gp,j)], SZ_FNAME)
}
}
delta = GP_AIRMASS(gp,2) - GP_AIRMASS(gp,1)
GP_AIRMASS(gp,1) = GP_AIRMASS(gp,1) - 0.05 * delta
GP_AIRMASS(gp,2) = GP_AIRMASS(gp,2) + 0.05 * delta
GP_WSTART(gp) = xmin
GP_WEND(gp) = xmax
call sf_title (gp, aperture, function, order, npts, rms)
# Enter cursor loop by drawing the graphs.
key = 'r'
repeat {
switch (key) {
case '?':
call gpagefile (GP_GIO(gp), KEY, PROMPT)
case ':':
call sf_colon (cmd, gp, stds, nstds, cv, wextn, extn, nextn,
ecv, function, order, npts, rms, newfit, newgraph)
case 'a':
call sf_add (gp, stds, nstds, cv, wx, wy, wc)
case 'c':
call sf_composite (stds, nstds, cv)
newfit = YES
newgraph = YES
case 'd':
call sf_data (stds, nstds, GP_GRAPHS(gp,wc))
call sf_nearest (gp, stds, nstds, wx, wy, wc, 0, i, j)
if (i > 0) {
call printf (
"%s - Delete p(oint), s(tar), or w(avelength):")
call pargstr (STD_IMAGE(stds[i]))
if (clgcur ("cursor", wx, wy, wc, key, cmd, SZ_FNAME)==EOF)
break
call printf ("\n")
call sf_delete (gp, stds, nstds, key, i, j)
}
case 'e':
call sf_extinct (gp, stds, nstds, cv, ecv, function, order)
newfit = YES
newgraph = YES
case 'f':
newfit = YES
case 'g':
newgraph = YES
newfit = YES
case 'i':
call sf_data (stds, nstds, GP_GRAPHS(gp,wc))
call sf_nearest (gp, stds, nstds, wx, wy, wc, 2, i, j)
if (i > 0) {
call printf (
"%s: airmass=%6.3f wavelen=%6.3f sens=%6.3f fit=%6.3f weight=%3f")
call pargstr (STD_IMAGE(stds[i]))
call pargr (STD_AIRMASS(stds[i]))
call pargr (Memr[STD_WAVES(stds[i])+j-1])
call pargr (Memr[STD_SENS(stds[i])+j-1])
call pargr (Memr[STD_FIT(stds[i])+j-1])
call pargr (Memr[STD_WTS(stds[i])+j-1])
}
case 'm':
call sf_data (stds, nstds, GP_GRAPHS(gp,wc))
call sf_nearest (gp, stds, nstds, wx, wy, wc, 2, i, j)
if (i > 0) {
call printf (
"%s - Move p(oint), s(tar), or w(avelength) to cursor:")
call pargstr (STD_IMAGE(stds[i]))
if (clgcur ("cursor", wx, wy, wc, key, cmd, SZ_FNAME)==EOF)
break
call printf ("\n")
delta = wy - Memr[STD_Y(stds[i])+j-1]
call sf_move (gp, stds, nstds, key, i, j, delta)
}
case 'o':
call sf_reset (stds, nstds, wextn, extn, nextn, ecv, shift)
newfit = YES
newgraph = YES
case 'q':
break
case 'I':
call fatal (0, "Interrupt")
case 'r':
newgraph = YES
case 's':
call sf_shift (stds, nstds, shift)
newfit=YES
newgraph=YES
case 'u':
call sf_data (stds, nstds, GP_GRAPHS(gp,wc))
call sf_nearest (gp, stds, nstds, wx, wy, wc, 1, i, j)
if (i > 0) {
call printf (
"%s - Undelete p(oint), s(tar), or w(avelength):")
call pargstr (STD_IMAGE(stds[i]))
if (clgcur ("cursor", wx, wy, wc, key, cmd, SZ_FNAME)==EOF)
break
call printf ("\n")
call sf_undelete (gp, stds, nstds, key, i, j)
}
case 'w':
call sf_data (stds, nstds, GP_GRAPHS(gp,wc))
call sf_nearest (gp, stds, nstds, wx, wy, wc, 0, i, j)
if (i > 0) {
call printf (
"%s - Reweight p(oint), s(tar), or w(avelength):")
call pargstr (STD_IMAGE(stds[i]))
if (clgcur ("cursor", wx, wy, wc, key, cmd, SZ_FNAME)==EOF)
break
call printf ("New weight (%g):")
call pargr (Memr[STD_IWTS(stds[i])+j-1])
call flush (STDOUT)
if (scan() != EOF) {
call gargr (delta)
if (nscan() == 1)
call sf_weights (stds, nstds, key, i, j, delta)
}
call printf ("\n")
}
default:
call printf ("\007")
}
# Do a new fit and recompute the RMS, and title string.
if (newfit == YES) {
call sf_fit (stds, nstds, cv, function, order, xmin, xmax)
call sf_rms (stds, nstds, rms, npts)
call sf_title (gp, aperture, function, order, npts, rms)
do i = 1, SF_NGRAPHS
if (GP_SHDR(gp,i) != NULL)
call shdr_close (GP_SHDR(gp,i))
}
# Draw new graphs.
if (newgraph == YES) {
call sf_graph (gp, stds, nstds, cv, wextn, extn, nextn, ecv)
newgraph = NO
newfit = YES
}
# Overplot new fit.
if (newfit == YES) {
call sf_fitgraph (gp, cv)
newfit = NO
}
} until (clgcur ("cursor", wx, wy, wc, key, cmd, SZ_FNAME) == EOF)
# Close any open images.
do i = 1, SF_NGRAPHS
if (GP_SHDR(gp,i) != NULL)
call shdr_close (GP_SHDR(gp,i))
output_
# Output the sensitivity function and logfile statistics.
call sf_output (stds, nstds, cv, sensimage, ignoreaps)
if (logfile[1] != EOS) {
iferr {
fd = open (logfile, APPEND, TEXT_FILE)
call sf_stats (fd, stds, nstds, function, order, npts, rms)
call sf_vstats (fd, stds, nstds, cv, wextn, extn, nextn, ecv)
call close (fd)
} then
call erract (EA_WARN)
}
call cvfree (cv)
end
|
