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
|
include <error.h>
include "refspectra.h"
# REFOPEN -- Set verbose and log file descriptors and open symbol table.
# REFCLOSE -- Close file descriptors and symbol table
# REFGSPEC -- Get a spectrum from the symbol table. Map it only once.
# REFGINPUT -- Get input spectrum. Apply various checks.
# REFGREF -- Get reference spectrum. Apply various checks.
define REF_LEN 6 # Length of reference structure
define REF_SORTVAL Memd[P2D($1)] # Sort value
define REF_AP Memi[$1+2] # Aperture number
define REF_GVAL Memi[$1+3] # Sort value
define REF_SPEC1 Memi[$1+4] # Offset for reference spectrum 1
define REF_SPEC2 Memi[$1+5] # Offset for reference spectrum 2
# REFOPEN -- Set verbose and log file descriptors and open symbol table.
# The file descriptors and symbol table pointer are in common. A null
# file descriptor indicates no output.
procedure refopen ()
bool clgetb()
real clgetr()
pointer rng_open(), stopen()
int fd, btoi(), clpopnu(), clgfil(), open(), nowhite()
errchk open()
include "refspectra.com"
begin
call malloc (sort, SZ_FNAME, TY_CHAR)
call malloc (group, SZ_FNAME, TY_CHAR)
# Check log files
logfiles = clpopnu ("logfiles")
while (clgfil (logfiles, Memc[sort], SZ_FNAME) != EOF) {
fd = open (Memc[sort], APPEND, TEXT_FILE)
call close (fd)
}
call clprew (logfiles)
# Get other parameters
call clgstr ("apertures", Memc[sort], SZ_FNAME)
iferr (aps = rng_open (Memc[sort], INDEF, INDEF, INDEF))
call error (0, "Bad aperture list")
call clgstr ("refaps", Memc[sort], SZ_FNAME)
iferr (raps = rng_open (Memc[sort], INDEF, INDEF, INDEF))
call error (0, "Bad reference aperture list")
call clgstr ("sort", Memc[sort], SZ_FNAME)
call clgstr ("group", Memc[group], SZ_FNAME)
time = btoi (clgetb ("time"))
timewrap = clgetr ("timewrap")
verbose = btoi (clgetb ("verbose"))
fd = nowhite (Memc[sort], Memc[sort], SZ_FNAME)
fd = nowhite (Memc[group], Memc[group], SZ_FNAME)
# Open symbol table.
stp = stopen ("refspectra", 10, 20, 10*SZ_FNAME)
end
# REFCLOSE -- Finish up
procedure refclose ()
include "refspectra.com"
begin
call mfree (sort, TY_CHAR)
call mfree (group, TY_CHAR)
call clpcls (logfiles)
call stclose (stp)
call rng_close (raps)
call rng_close (aps)
end
# REFGSPEC -- Get a spectrum from the symbol table. Map it only once.
# All access to spectra is through this routine. It returns header parameters.
# Because the spectra may be accessed in very random order and many times
# the information is stored in a symbol table keyed on the spectrum name.
# The spectrum need be mapped only once! Any error from IMMAP is returned.
procedure refgspec (spec, ap, sortval, gval, ref1, ref2)
char spec[ARB] # Spectrum image name
int ap # Spectrum aperture number
double sortval # Spectrum sort value
pointer gval # Group string
pointer ref1 # Reference spectrum 1
pointer ref2 # Reference spectrum 2
pointer sym, stfind(), stenter(), stpstr(), strefsbuf()
pointer im, str, immap()
bool streq()
int imgeti(), strlen()
double imgetd()
errchk immap, imgetd, imgstr
include "refspectra.com"
begin
# Check if spectrum is in the symbol table from a previous call.
# If not in the symbol table map the image, get the header parameters,
# and store them in the symbol table.
sym = stfind (stp, spec)
if (sym == NULL) {
im = immap (spec, READ_ONLY, 0)
iferr (ap = imgeti (im, "BEAM-NUM"))
ap = 1
# Failure to find a specified keyword is a fatal error.
iferr {
if (Memc[sort] == EOS || streq (Memc[sort], "none") ||
select == MATCH || select == AVERAGE)
sortval = INDEFD
else {
sortval = imgetd (im, Memc[sort])
if (time == YES)
sortval = mod (sortval + 24. - timewrap, 24.0D0)
}
call malloc (str, SZ_FNAME, TY_CHAR)
if (Memc[group] == EOS || streq (Memc[group], "none") ||
select == MATCH || select == AVERAGE)
Memc[str] = EOS
else
call imgstr (im, Memc[group], Memc[str], SZ_FNAME)
gval = stpstr (stp, Memc[str], strlen (Memc[str])+1)
} then
call erract (EA_FATAL)
iferr (call imgstr (im, "refspec1", Memc[str], SZ_FNAME))
Memc[str] = EOS
ref1 = stpstr (stp, Memc[str], strlen (Memc[str])+1)
iferr (call imgstr (im, "refspec2", Memc[str], SZ_FNAME))
Memc[str] = EOS
ref2 = stpstr (stp, Memc[str], strlen (Memc[str])+1)
call mfree (str, TY_CHAR)
call imunmap (im)
sym = stenter (stp, spec, REF_LEN)
REF_AP(sym) = ap
REF_SORTVAL(sym) = sortval
REF_GVAL(sym) = gval
REF_SPEC1(sym) = ref1
REF_SPEC2(sym) = ref2
}
ap = REF_AP(sym)
sortval = REF_SORTVAL(sym)
gval = strefsbuf (stp, REF_GVAL(sym))
ref1 = strefsbuf (stp, REF_SPEC1(sym))
ref2 = strefsbuf (stp, REF_SPEC2(sym))
end
# REFGINPUT -- Get input spectrum. Apply various checks.
# This calls REFGSPEC and then checks:
# 1. The spectrum is found.
# 2. The spectrum has not been assigned reference spectra previously.
# If it has then determine whether to override the assignment.
# 3. Check if the aperture is correct.
# Return true if the spectrum is acceptable and false if not.
bool procedure refginput (spec, ap, val, gval)
char spec[ARB] # Spectrum image name
int ap # Spectrum aperture number (returned)
double val # Spectrum sort value (returned)
pointer gval # Spectrum group value (returned)
bool clgetb(), rng_elementi()
pointer ref1, ref2
errchk refgspec
include "refspectra.com"
define err_ 99
begin
# Get the spectrum from the symbol table.
iferr (call refgspec (spec, ap, val, gval, ref1, ref2)) {
call refmsgs (NO_SPEC, spec, "", "", "", ap, 0, "")
goto err_
}
# Check if it has a previous reference spectrum. Override if desired.
if (Memc[ref1] != EOS) {
if (!clgetb ("override")) {
call refmsgs (DEF_REFSPEC, spec, Memc[ref1], "", "", ap, 0,
Memc[ref2])
goto err_
} else {
call refmsgs (OVR_REFSPEC, spec, Memc[ref1], "", "", ap, 0,
Memc[ref2])
}
}
# Check aperture numbers.
if (aps != NULL) {
if (!rng_elementi (aps, ap)) {
call refmsgs (BAD_AP, spec, "", "", "", ap, 0, "")
goto err_
}
}
return (true)
err_
return (false)
end
# REFGREF -- Get reference spectrum. Apply various checks.
# This calls REFGSPEC and then checks:
# 1. The spectrum is found.
# 2. The spectrum is a reference spectrum, i.e. has an IDENTIFY
# record. This is signaled by having a reference equivalent to
# itself.
# 3. Check if the aperture is correct.
# Return true if the spectrum is acceptable and false if not.
bool procedure refgref (spec, ap, val, gval)
char spec[ARB] # Spectrum image name
int ap # Spectrum aperture number (returned)
double val # Spectrum sort value (returned)
pointer gval # Spectrum group value (returned)
bool strne(), rng_elementi()
pointer ref1, ref2
errchk refgspec
include "refspectra.com"
define err_ 99
begin
# Get spectrum from symbol table.
iferr (call refgspec (spec, ap, val, gval, ref1, ref2)) {
call refmsgs (NO_REF, spec, "", "", "", ap, 0, "")
goto err_
}
# Check if spectrum is a reference spectrum.
if (strne (spec, Memc[ref1])) {
call refmsgs (NOT_REFSPEC, spec, "", "", "", ap, 0, "")
goto err_
}
# Check aperture numbers.
if (raps != NULL) {
if (!rng_elementi (raps, ap)) {
call refmsgs (BAD_REFAP, spec, "", "", "", ap, 0, "")
goto err_
}
}
return (true)
err_
return (false)
end
|
