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
|
include <ctype.h>
include <gset.h>
include <imhdr.h>
include <error.h>
include "rvcomdef.h"
include "rvpackage.h"
include "rvflags.h"
include "rvsample.h"
# T_FXCOR - Task entry point code. Initial procedure just handles the
# aquisition of the images and passes the pointers on to other work routines.
procedure t_fxcor()
pointer rv # RV struct pointer
pointer sp, device, root # stack storage
pointer infile, rinfile # image list pointers
pointer rv_open(), imtopenp()
int rv_imio(), rv_clpars()
int imtlen()
bool interactive, clgetb()
errchk rv_open, rv_clpars, rv_imio
define error_ 99
begin
call smark (sp)
call salloc (device, SZ_FNAME, TY_CHAR)
call salloc (root, SZ_FNAME, TY_CHAR)
# Get file names of the spectra and open the package structure.
call clgstr ("output", Memc[root], SZ_FNAME)
call clgstr ("graphics", Memc[device], SZ_FNAME)
interactive = clgetb ("interactive")
rv = rv_open (Memc[root], Memc[device], interactive)
# Do some CLIO to get some more parameters.
infile = imtopenp ("objects")
rinfile = imtopenp ("templates")
RV_OBJECTS(rv) = infile # various initializations
RV_TEMPLATES(rv) = rinfile
RV_NOBJS(rv) = imtlen (infile)
RV_NTEMPS(rv) = imtlen (rinfile)
RV_RECORD(rv) = 0
RV_TEMPNUM(rv) = 1
RV_IMNUM(rv) = 1
if (rv_clpars(rv) == ERR_READ)
goto error_
# Read the images and let's get started
RV_TEMPNUM(rv) = 1
RV_OAPNUM(rv) = RV_APNUM(rv)
RV_RAPNUM(rv) = RV_APNUM(rv)
if (rv_imio(rv,infile,rinfile) == ERR_READ)
goto error_
# Open the graphics and gtools pointers
if (RV_GP(rv) == NULL)
call init_gp (rv, interactive, DEVICE(rv))
if (RV_INTERACTIVE(rv) == YES) {
RV_GTYPE(rv) = CORRELATION_PLOT
call rv_cursor (rv, infile, rinfile)
} else
call rv_batch (rv, infile, rinfile)
error_ call imtclose (RV_OBJECTS(rv)) # close list pointers
call imtclose (RV_TEMPLATES(rv))
call rv_close (rv) # free the structure
call flush (STDOUT)
call sfree (sp)
end
# RV_CLPARS - Get the parameters from the par file.
int procedure rv_clpars (rv)
pointer rv # RV struct pointer
pointer sp, func, ap, cont, rb, filt, vb, ccf, obs
int code
bool clgetb()
real clgetr(), obsgetr()
pointer obsopen()
int rv_apnum_range(), rv_mask_regions(), rv_chk_filter(), cod_verbose()
int cod_fitfunc(), cod_which(), btoi(), cod_ccftype(), cod_rebin()
errchk obsopen, rv_apnum_range, obsgetr
begin
call smark (sp)
call salloc (ccf, SZ_FNAME, TY_CHAR)
call salloc (cont, SZ_FNAME, TY_CHAR)
call salloc (rb, SZ_FNAME, TY_CHAR)
call salloc (filt, SZ_FNAME, TY_CHAR)
call salloc (func, SZ_FNAME, TY_CHAR)
call salloc (ap, SZ_FNAME, TY_CHAR)
call salloc (vb, SZ_FNAME, TY_CHAR)
call salloc (obs, SZ_FNAME, TY_CHAR)
code = OK
RV_APODIZE(rv) = clgetr ("apodize")
RV_AUTOWRITE(rv) = btoi (clgetb("autowrite"))
RV_AUTODRAW(rv) = btoi (clgetb("autodraw"))
RV_BACKGROUND(rv) = clgetr ("background")
RV_FITHGHT(rv) = clgetr ("height")
RV_FITWIDTH(rv) = clgetr ("width")
RV_IMUPDATE(rv) = btoi (clgetb ("imupdate"))
RV_MINWIDTH(rv) = clgetr ("minwidth")
RV_MAXWIDTH(rv) = clgetr ("maxwidth")
RV_PEAK(rv) = btoi (clgetb("peak"))
RV_PIXCORR(rv) = btoi (clgetb("pixcorr"))
RV_WEIGHTS(rv) = clgetr ("weights")
RV_WINPAR(rv) = clgetr ("window")
RV_WINCENPAR(rv) = clgetr ("wincenter")
call clgstr ("ccftype", Memc[ccf], SZ_FNAME)
RV_CCFTYPE(rv) = cod_ccftype (Memc[ccf])
call clgstr ("continuum", Memc[cont], SZ_FNAME)
RV_CONTINUUM(rv) = cod_which (Memc[cont])
call clgstr ("rebin", Memc[rb], SZ_FNAME)
RV_REBIN(rv) = cod_rebin (Memc[rb])
call clgstr ("filter", Memc[filt], SZ_FNAME)
RV_FILTER(rv) = cod_which (Memc[filt])
if (RV_FILTER(rv) == BOTH || RV_FILTER(rv) == OBJ_ONLY) {
if (rv_chk_filter(rv,OBJECT_SPECTRUM) != OK)
call error (0, "Invalid filter specification.")
} else if (RV_FILTER(rv) == BOTH || RV_FILTER(rv) == TEMP_ONLY) {
if (rv_chk_filter(rv,REFER_SPECTRUM) != OK)
call error (0, "Invalid filter specification.")
}
call clgstr ("function", Memc[func], SZ_FNAME)
RV_FITFUNC(rv) = cod_fitfunc (Memc[func])
call clgstr ("apertures", Memc[ap], SZ_FNAME)
code = rv_apnum_range (rv, Memc[ap])
# Get the regions to mask (if any)
if (rv_mask_regions(rv) == ERR)
call rv_errmsg ("Error getting masking regions.")
# Open observatory database and get the observatory parameters
iferr {
call clgstr ("observatory", Memc[obs], SZ_FNAME)
RV_OBSPTR(rv) = obsopen (Memc[obs])
} then
call error (0, "Error opening `observatory' database.")
iferr {
RV_ALTITUDE(rv) = obsgetr (RV_OBSPTR(rv), "altitude")
RV_LATITUDE(rv) = obsgetr (RV_OBSPTR(rv), "latitude")
RV_LONGITUDE(rv) = obsgetr (RV_OBSPTR(rv), "longitude")
} then
call error (0, "Error getting observatory parameters.")
# Now get the filter pset information
call filt_get_pars (rv)
# Parse the verbose parameter
call clgstr ("verbose", Memc[vb], SZ_FNAME)
RV_VERBOSE(rv) = cod_verbose (Memc[vb])
if (RV_VERBOSE(rv) == ERR) {
call error (0,
"`verbose' must be one of `short|long|nogki|nolog|txtonly'")
}
# Check for a debug session
if (RV_APODIZE(rv) == 0.116)
call op_debug (rv)
call sfree (sp)
return (code)
end
# RV_MASK_REGIONS - Decode the sample regions string.
int procedure rv_mask_regions (rv)
pointer rv #I RV struct pointer
pointer sp, buf1, buf2
int rv_load_sample()
bool streq()
errchk samp_open
begin
call smark (sp)
call salloc (buf1, SZ_LINE, TY_CHAR); call aclrs (Memc[buf1], SZ_LINE)
call salloc (buf2, SZ_LINE, TY_CHAR); call aclrs (Memc[buf2], SZ_LINE)
call clgstr("osample", Memc[buf1], SZ_LINE)
call clgstr("rsample", Memc[buf2], SZ_LINE)
# Parse the object parameter. We also allocate the sample
# structure here since this routine isn't called anywhere else.
iferr (call samp_open (RV_OSAMPLE(rv)))
call error (0, "Error allocating object sample structure.")
SR_IMTYPE(RV_OSAMPLE(rv)) = OBJECT_SPECTRUM
SR_MODIFY(RV_OSAMPLE(rv)) = NO
SR_PARENT(RV_OSAMPLE(rv)) = rv
SR_COUNT(RV_OSAMPLE(rv)) = 0
if (streq(Memc[buf1],"") || streq(Memc[buf1]," ")) {
call error (0, "`osample' parameter specified as a NULL string")
} else if (streq(Memc[buf1], "*")) {
ORCOUNT(rv) = ALL_SPECTRUM
} else {
if (rv_load_sample(RV_OSAMPLE(rv), Memc[buf1]) == ERR) {
call sfree (sp)
return (ERR)
}
}
# Parse the template sample parameter.
iferr (call samp_open (RV_RSAMPLE(rv)))
call error (0, "Error allocating template sample structure.")
SR_IMTYPE(RV_RSAMPLE(rv)) = REFER_SPECTRUM
SR_MODIFY(RV_RSAMPLE(rv)) = NO
SR_PARENT(RV_RSAMPLE(rv)) = rv
SR_COUNT(RV_RSAMPLE(rv)) = 0
if (streq(Memc[buf2],"") || streq(Memc[buf2]," ")) {
call error (0, "`rsample' parameter specified as a NULL string")
} else if (streq(Memc[buf2], "*")) {
RRCOUNT(rv) = ALL_SPECTRUM
} else {
if (rv_load_sample(RV_RSAMPLE(rv), Memc[buf2]) == ERR) {
call sfree (sp)
return (ERR)
}
}
call sfree (sp)
return (OK)
end
# RV_IMIO - Do the initial image io for the RVXCOR task. Process all of
# the template spectra and read the first object spectrum.
int procedure rv_imio (rv, infile, rinfile)
pointer rv #I RV struct pointer
pointer infile #I Object list input file
pointer rinfile #I Template list input file
pointer sp, fname
int rv_getim(), imtgetim()
int read_template_list()
errchk rv_getim, read_template_list
define error_ 99
begin
call smark (sp)
call salloc (fname, SZ_FNAME, TY_CHAR)
# Get the first input image.
if (infile != NULL) {
if (imtgetim (infile,Memc[fname],SZ_FNAME) == EOF) {
call rv_errmsg ("No input object images in list.")
goto error_
}
}
# Now read in the first OBJECT spectrum.
if (rv_getim (rv, Memc[fname], OBJECT_SPECTRUM, INDEF, INDEF,
INDEFI) == ERR_READ)
goto error_
# Read in the template data.
# First get all of the template spectra.
if (read_template_list (rv, rinfile) == ERR_READ)
goto error_
call sfree (sp)
return (OK)
error_ call sfree (sp)
return (ERR_READ)
end
|
